excel - 数组分配适用于 ThisWorkbook 模块，但不适用于 Sheet1 模块

Question

下面的代码旨在从一个复制数据，将其Workbook粘贴到另一个的底部，然后从目标文件中删除重复项。

我最初在模块中开发代码，但是当我向 Sheet1 添加一个按钮以触发宏时，它在尝试将源文件中的数据分配到数组ThisWorkbook时被踢出。newData

这感觉像是与 Excel 的行为有关的问题，我不太熟悉。

编辑：我还尝试过剪切数组并简单地使用Cells.Value在目标文件中分配Cells.Value源文件的“传输”方法。它可以很好地移动数据，但随后.removeDuplicates什么也不做。它不会出现错误，但不会删除任何重复项。

谢谢！！！

For i = 0 To 16
    colArray(i) = i + 1
Next i

location = "R:\dummyLocation"

destLastRow = Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Workbooks.Open (location & "SOURCE_FILE.xlsx")
Workbooks("SOURCE_FILE.xlsx").Worksheets(1).Activate
sourceLastRow = Workbooks("SOURCE_FILE.xlsx").Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
newData = Workbooks("SOURCE_FILE.xlsx").Worksheets(1).Range(Cells(3, 1), Cells(sourceLastRow, 17))
Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Activate
Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Range("A:Q").NumberFormat = "@"
Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Range(Cells(destLastRow + 1, 1), Cells(destLastRow + sourceLastRow - 2, 17)) = newData
destLastRow = Workbooks("DESTINATION_FILE.xlsx").Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Set cbuRange = Range(Cells(1, 1), Cells(destLastRow, 17))
cbuRange.RemoveDuplicates Columns:=(colArray), Header:=xlYes
Workbooks("DESTINATION_FILE.xlsx").Save
Workbooks("DESTINATION_FILE.xlsx").Close
Workbooks("SOURCE_FILE.xlsx").Close

标签： excelvba

Answer 1

我仍然不是 100% 造成这种情况的原因，但它可能是很多事情。如果它可能有帮助，这里是使用变量来跟踪工作表而不是依赖.activate并希望最好的这个片段的快速重写：

For i = 0 To 16
    colArray(i) = i + 1
Next i

location = "R:\dummyLocation"


'Source work
Dim sfWB as Workbook
Set sfWB = Workbooks.Open (location & "SOURCE_FILE.xlsx")
Dim sfWS as Worksheet
Set sfWS = sfWB.Worksheets(1)
sourceLastRow = sfWS.Cells(Rows.Count, 1).End(xlUp).Row

'This is a variant, but here it will act like a range, so `Set` should be used:
Set newData = sfWS.Range(sfWS.Cells(3, 1), sfWS.Cells(sourceLastRow, 17))

'destination work
Dim dfWS as Worksheet
Set dfWS = Workbooks("DESTINATION_FILE.xlsx").Worksheets(1)

dfWS.Range("A:Q").NumberFormat = "@"
destLastRow =sfWS.Cells(Rows.Count, 1).End(xlUp).Row

'Copy source data to destination
newData.Copy Destination:=dfWS.Cells(destLastRow + 1, 1)

'get new last row
destLastRow = dfWS.Cells(Rows.Count, 1).End(xlUp).Row

'Set cbuRange range object and remove dupes
Set cbuRange = dfWS.Range(dfWS.Cells(1, 1), dfWS.Cells(destLastRow, 17))
cbuRange.RemoveDuplicates Columns:=(colArray), Header:=xlYes

'Save and exit
dfWB.Save
dfWB.Close
sfWB.Close