Question

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

我最初是在ThisWorkbook模块中开发代码的，但是我在Sheet1中添加了一个按钮来触发宏时，在尝试将数据从源文件分配到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

Answer 1

我仍然不是100％的原因，但这可能很多。如果有帮助，可以使用变量来跟踪工作表，而不是依靠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并希望达到最佳效果，来快速重写此代码段：

{{1}}

数组分配在ThisWorkbook模块中起作用，但在Sheet1模块中不起作用

1 个答案: