Question

你好，我的代码应该很清楚我现在要做的是什么。我试图将一系列单元格从工作表的静态部分复制到创建的列，但我在公式的某个部分遇到错误我希望这里有人能够解决错误，或者一种更好的方法，可以采用一系列可以是静态的细胞并使参考点变硬（

）

Sub Mapping()

Dim Map As Worksheet
Dim Ath As Worksheet
Dim lastmap As Long
Dim lastath As Long
Set Ath = Sheets("Athena Greek God")
Set Map = Sheets("Mapping")
lastmap = Map.Cells(Rows.Count, "D").End(xlUp).Row
lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row



Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A1") = "EDITED"
Range("B1") = "EDITED 2"
Range("C1") = "EDITED 3"
Range("D1") = "EDITED 4"
Columns("A:D").AutoFit
Range("A1:D" & lastath).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With

Clastath = Ath.Cells(1, Columns.Count).End(xlToLeft).Column

For x = Clastath To 1 Step -1
If ath.Cells(1, x) = "The Principals Book" Then
    ath.Range("D2: D" & lastath) = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x))
End If
Next
End Sub

此处出现错误：

ath.Range("D2: D" & lastath) = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x))

Answer 1

您应该使用.Value或.Value2在范围之间传输数据，如下所示：

Ath.Range("D2: D" & LastAth).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(LastAth, x)).Value2

这两者之间的主要区别是：

.Value2为您提供单元格的基础值（无格式数据）
.Value为您提供单元格的格式化值

有关详细信息，请查看Charles William's blog here.

正如您似乎正在处理两张（不是在您提供的代码中的“映射”中，如果我做对了。如果不是，只需将Ath.更改为{ {1}}它需要的地方，不要忘记使用您创建的参考（我已将它们添加到任何地方，甚至在Map.和Rows.Count之前，以避免错误如果您在新的Excel版本上打开旧文档）

我摆脱了Columns.Count并尽可能地缩短了代码，但我想到了“映射”表格，因为我猜你以后会在代码中使用它。

另外，当你以后不使用它时，不要忘记释放你这样的abject变量：

Select

您的代码已经过更正，清理和测试：

Set Ath = Nothing
Set Map = Nothing

Answer 2

取出：

之后的空格

我也砍掉了你的代码，Dimmed X并为你删除了选择：

Sub Mapping()

Dim Map As Worksheet, Ath As Worksheet, lastmap As Long, lastath As Long, X As Long, Clastath As Long
Set Ath = Sheets("Athena Greek God")
Set Map = Sheets("Mapping")
lastmap = Map.Cells(Rows.Count, "D").End(xlUp).Row
lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row

Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1:D1") = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4")
Columns("A:D").AutoFit
With Range("A1:D" & lastath).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With

Clastath = Ath.Cells(1, Columns.Count).End(xlToLeft).Column

For X = Clastath To 1 Step -1
    If Cells(1, X) = "The Principals Book" Then
        Range("D2:D" & lastath) = Range(Cells(2, X), Cells(lastath, X))
    End If
Next
End Sub

编辑：长时间使克拉斯塔斯变暗

Answer 3

实际上，这段代码应该实现的并不是很明显，告诉你为什么：定义了两个工作表，但只使用了其中一个工作表，而且还不清楚要应用代码的工作表。现在，代码将应用于任何活动的工作表。

请参阅下面的代码并进行调整和评论。该代码假定该过程应该适用于Ath工作表（根据需要进行更改）

虽然已经解释了这些更改，但请告诉我您可能遇到的任何问题。

Option Explicit
Option Base 1

Sub Mapping()
Rem Worksheet "Map" is only used to obtain lastmap which is never used
Rem Therefore theese line are commented as they do not play any role in the procedure
'Dim Map As Worksheet
'Dim lastmap As Long
'Set Map = Sheets("Mapping")
'lastmap = Map.Cells(Rows.Count, "D").End(xlUp).Row ' NOT USED?

Rem Set array with titles - easy to maintain, and use to command all further intructions avoiding hard codding
Dim aTitles As Variant
aTitles = [{"EDITED","EDITED 2","EDITED 3","EDITED 4"}]

Dim Ath As Worksheet
Dim lastath As Long
Dim Clastath As Integer
Dim X As Integer

    Set Ath = Sheets("Athena Greek God")

    Rem It's not clear to which worksheet the code is to be applied?
    Rem Actually it is applied to whatever worksheet is active
    Rem This code assumes the procedure should be apply to the Ath worksheet
    With Ath '(change as needed)
        lastath = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(1).Resize(, UBound(aTitles)).EntireColumn.Insert     'Using Titles array to insert required number of columns
        With Range(.Cells(1, 1), .Cells(lastath, UBound(aTitles)))  'Working with the range to be updated
            .Rows(1).Value = aTitles
            .Columns.AutoFit
            .Interior.Color = RGB(217, 217, 217)                    'Simplify method to set color

            Clastath = .Cells(1, Columns.Count).End(xlToLeft).Column

            Rem Use "Step -1" if you have more than one cell with value = "The Principals Book"
            Rem and you whant to catch the last occurrence. Otherwise no need to use it.
            Rem For X = Clastath To 1 Step -1 '(change if needed as per comment above)
            For X = 1 To Clastath
                If .Cells(1, X).Value = "The Principals Book" Then
                    Rem Old line, left only to show changes (.Value and .Value2)
                    Rem Ath.Range("D2: D" & lastath).Value = Ath.Range(Ath.Cells(2, X), Ath.Cells(lastath, X)).Value2
                    Ath.Range("D2: D" & lastath).Value = Ath.Range(Ath.Cells(2, X), Ath.Cells(lastath, X)).Value2
                    .Columns(4).Value = .Columns(1).Offset(0, X - 1).Value2
                    Exit For    'Exit For...Next after achieving its goal

    End If: Next: End With: End With

    Ath.Activate 'Only used to show\move to the worksheet updated

End Sub

Answer 4

您的代码值得多次评论。首先，您必须解决您的问题（参见第1点）。此外，有几点可以减少修改后出错的几率，提高效率。

使用其他方法复制Range s 您必须指定要复制的内容（数据，公式，数字格式等）以决定使用哪种方法。

仅复制数据。

Ath.Range("D2:D" & lastath).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Value2

或

Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy
Ath.Range("D2:D" & lastath).PasteSpecial xlPasteValues

复制（部分或全部）数字格式。请参阅this。

Ath.Range("D2:D" & lastath).Value = Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Value

或

Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy
Ath.Range("D2:D" & lastath).PasteSpecial xlPasteValuesAndNumberFormats

复制公式。

Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy
Ath.Range("D2:D" & lastath).PasteSpecial xlPasteFormulas  ' or xlPasteFormulasAndNumberFormats

全部复制。

Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy
Ath.Range("D2:D" & lastath).PasteSpecial xlPasteAll

或

Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy Destination:=Ath.Range("D2:D" & lastath)

完全符合Range 的资格。
此问题一次又一次出现（例如this） 这是什么意思？不指定Cells，Range，Rows或Columns而不指定他们属于哪个Worksheet，除非您特别想要这样做（即使在这种情况下，明确使用ActiveSheet可以提高可读性并减少出错的可能性，类似于使用Option Explicit）。例如，
```
lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row
```
将从Rows.Count ActiveSheet获取，Ath可能不是lastath = Ath.Cells(Ath.Rows.Count, "A").End(xlUp).Row。你可能不希望这样。正确的形式是
```
Range
```
修复所有其他代码。注意：在这种情况下，代码继续执行，错误可能会被忽视，因为它会产生有效的结果。在其他情况下，没有完全限定sheet1.Range(Cells(...的代码会抛出错误（例如sheet1，ActiveSheet不是Range）。
您的代码似乎效率低下 您可能会多次将数据复制到同一"The Principals Book"中。最好找到包含Range("D2:D" & lastath)的第1行中最左边的单元格，并将该列的范围复制到Dim x As Long For x = 1 To Clastath If Ath.Cells(1, x) = "The Principals Book" Then Ath.Range("D2:D" & lastath).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Value2 ' or alternatives above Exit For End If Next。使用
```
Worksheet
```
目前尚不清楚要插入哪些Ath 。
它似乎是Worksheet。其他Ath.Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Ath.Range("A1:D1").Value = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4")未使用。

您可以一次插入多个列。您也可以一次将数据输入范围。

clean:
    @if [ "test" = "test" ]; then\
        echo "Hello world";\
    fi

Answer 5

1.删除字符串地址中的空格：之前：

ath.Range("D2: D" & lastath))

后：

ath.Range("D2:D" & lastath))

2a上。如果您只想复制值，请在范围引用的末尾使用.value：之前：

ath.Range("D2:D" & lastath).value = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x))

后：

ath.Range("D2:D" & lastath).value = ath.Range(ath.Cells(2, x).value, ath.Cells(lastath, x).value).value

2B。如果您想要值和格式，请使用.copy（destination）：之前：

ath.Range("D2:D" & lastath).value = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x))

后：

ath.Range("D2:D" & lastath).copy(ath.Range(ath.Cells(2, x).value, ath.Cells(lastath, x).value))

此外，您应始终参考参考范围的工作表（例如ws.range("A1").value）。您可能还会考虑使用工作表的.codename而不是.name，如果这不仅仅是一个快速的脏项目。

将基于变量的单元格范围复制到另一个范围

5 个答案: