將基於變量的單元格范圍復制到另一個范圍

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

兩者之間的主要區別是：

1. .Value2為您提供單元格的基礎值（未格式化的數據）
2. .Value為您提供單元格的格式化值

有關更多詳細信息，請在此處查看Charles William的博客。

---

正如您似乎在處理兩張紙一樣 （如果您沒有Ath. ， 請不要在給出的代碼中“映射”一張紙上 。如果不只是將Ath.更改為需要的Map. ）， 請不要忘記使用您創建的引用 （我加了他們無處不在，甚至在Rows.Count和Columns.Count如果你打開一個新的Excel版本的舊文件，以避免錯誤）

我擺脫了Select並在可能的地方縮短了代碼，但是我猜想您稍后將在代碼中使用“映射”表。

另外，當以后不再使用它時，也不要忘記釋放這樣的變量：

Set Ath = Nothing
Set Map = Nothing

---

---

這是您的代碼已更正，清除和測試的代碼 ：

Sub Mapping()

Dim Map As Worksheet, _
    Ath As Worksheet, _
    LastAth As Long, _
    LastMap As Long, _
    CLastAth As Long, _
    x As Integer


Set Ath = Sheets("Athena Greek God")
Set Map = Sheets("Mapping")
LastMap = Map.Cells(Map.Rows.Count, "D").End(xlUp).Row
LastAth = Ath.Cells(Ath.Rows.Count, "A").End(xlUp).Row

Ath.Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Ath.Range("A1:D1").Value = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4")
Ath.Columns("A:D").AutoFit

With Ath.Range("A1:D" & LastAth).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With


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

For x = CLastAth To 1 Step -1
    If Ath.Cells(1, x) <> "The Principals Book" Then
    Else
        Ath.Range("D2: D" & LastAth).Value = Ath.Range(Ath.Cells(2, x), Ath.Cells(LastAth, x)).Value
    End If
Next x

Set Ath = Nothing
Set Map = Nothing

End Sub

Answer 2

取出空格：

我也將您的代碼切碎，變暗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

編輯：Clastath也變暗了

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點）。 另外，幾點可以減少修改時出錯的機會，並提高效率。

1. 使用其他方法復制Range 。
   您必須指定要復制的內容（數據，公式，數字格式等），以決定使用哪種方法。

   • 僅復制數據。

      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 

   • 復制（部分或全部）數字格式。 看到這個 。

      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) 

2. 完全限定您的Range 。
   這個問題一次又一次地出現（例如this ）。
   這是什么意思？ 不要使用Cells ， Range ， Rows或Columns而不指定它們屬於哪個Worksheet ，除非您特別想要這樣做（即使在那種情況下，顯式使用ActiveSheet可以提高可讀性並減少出錯的可能性，類似於使用Option Explicit ） 。 例如，

    lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row 

   將從ActiveSheet獲取Rows.Count ，它可能不是Ath 。 您可能不希望那樣。 正確的形式是

    lastath = Ath.Cells(Ath.Rows.Count, "A").End(xlUp).Row 

   修正所有其他代碼。 注意 ：在這種情況下，代碼將繼續執行，並且錯誤可能會被忽略，因為它會產生有效的結果。 在其他情況下，沒有完全限定的Range的代碼將引發錯誤（例如，帶有sheet1.Range(Cells(... ，當sheet1不是ActiveSheet ）。

3. 您的代碼似乎效率低下 。
   您可能多次將數據復制到同一Range 。 最好在第1行中找到最左側的單元格，其中包含"The Principals Book" ，並將該列的范圍復制到Range("D2:D" & lastath) 。 采用

    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 

4. 目前尚不清楚要在哪個Worksheet表中插入列 。
   好像是Ath 。 不使用其他Worksheet 。

5. 您可以一次插入許多列。 您也可以一次將數據輸入一個范圍 。

    Ath.Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Ath.Range("A1:D1").Value = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4") 

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（目標）：在之前：

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。