Назначение массива работает в модуле ThisWorkbook, но не в модуле Sheet1 - PullRequest
0 голосов
/ 27 июня 2019

Приведенный ниже код предназначен для копирования данных из одного Workbook, вставки его внизу другого, а затем удаления дубликатов из файла назначения.

Изначально я разработал код в модуле ThisWorkbook, но когда я добавил кнопку в Sheet1 для запуска макроса, он вылетает при попытке назначить данные из исходного файла в массив newData.

Это похоже на проблему, связанную с поведением Excel, с которой я менее знаком.

Редактировать: я также экспериментировал с вырезанием массива и простым использованием метода «Transfer», в котором 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

1 Ответ

0 голосов
/ 27 июня 2019

Я все еще не на 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...