Мне нужны суммарные значения столбцов из нескольких книг и листов на одном листе. Если я пытаюсь сделать это так:
While targetCell.Row <> LastRow
targetCell.Value = targetCell.Value + sourseCell.Value
Set sourseCell = sourseSheet.Cells(sourseCell.Row + 1, sourseCell.Column)
Set targetCell = targetSheet.Cells(targetCell.Row + 1, targetCell.Column)
Wend
Это занимает слишком много времени (часов !!!).
Как это:
targetSheet.Range("D14:BJ" & LastRow).Value = targetSheet.Range("D14:BJ" & LastRow).Value + sourseSheet.Range("D14:BJ" & LastRow).Value
Иногда у меня возникает несоответствие типа ошибки
Полный код:
For Each foldername In subFolders
If foldername <> ThisWorkbook.path Then
filePath = foldername & fileName
Dim app As New Excel.Application
app.Visible = False
Dim book As Excel.Workbook
Set book = app.Workbooks.Add(filePath)
For Each targetSheet In ActiveWorkbook.Worksheets
Dim sourseSheet As Worksheet
Set sourseSheet = book.Worksheets(targetSheet.Name)
Call CopyColumn(targetSheet, sourseSheet, LastRow)
Next
book.Close SaveChanges:=False
app.Quit
Set app = Nothing
End If
Next
Sub CopyColumn(targetSheet, sourseSheet As Worksheet, LastRow As Integer)
Dim sourseCell, targetCell As Range
Set targetCell = targetSheet.Cells(14,"D")
Set sourseCell = sourseCell.Cells(14,"CH")
While targetCell.Row <> LastRow
targetCell.Value = targetCell.Value + sourseCell.Value
Set sourseCell = sourseSheet.Cells(sourseCell.Row + 1, sourseCell.Column)
Set targetCell = targetSheet.Cells(targetCell.Row + 1, targetCell.Column)
Wend
End Sub
1
26 Май 2014 в 14:31
Пожалуйста, добавьте полный код - это внутри процедуры события изменения рабочего листа? то есть это пользовательская функция? Если да, то сколько раз функция используется на целевом листе? тысячи раз?
–
26 Май 2014 в 14:38
Он используется при открытии документа или нажатии кнопки примерно 3000 раз (у меня более 140 документов и 20 рабочих листов).
–
26 Май 2014 в 14:45
2 способ намного быстрее, но иногда у меня возникают ошибки (если какие-либо ячейки в диапазоне пусты и никогда не меняются) О, я ошибаюсь, он использовался более 14000 раз
–
26 Май 2014 в 14:55
2 ответа
Лучший ответ
Копирование диапазонов в массивы Variant выполняется довольно быстро. Ваша подпрограмма изменена и прокомментирована ниже:
Sub CopyColumn(targetSheet As Worksheet, sourseSheet As Worksheet, LastRow As Long)
' LastRow as Integer will give an error for rows > 32,767, use Long instead
' Check the syntax: sourseCell, targetCell as Range means:
' sourceCell as Variant, targetCell as Range. We should include
' "as Range" after each variable declaration if we want it to be a Range
Dim sourseCell As Range, targetCell As Range
Dim lCount As Long
Dim vTarget, vSource
' I kept the names targetCell, sourseSheet, but turned them to ranges
' You might want to change sourseSheet to sourceSheet
With targetSheet
Set targetCell = .Range(.Cells(14, "D"), .Cells(LastRow, "D"))
End With
' I assume you mean sourceSheet instead of sourceCell,
' in your original code?
With sourseSheet
Set sourseCell = .Range(.Cells(14, "CH"), .Cells(LastRow, "CH"))
End With
vTarget = targetCell.Value2
vSource = sourseCell.Value2
' If there is a change you do not have numeric values
' this needs error trapping
For lCount = LBound(vTarget, 1) To UBound(vTarget, 1)
vTarget(lCount, 1) = vTarget(lCount, 1) + vSource(lCount, 1)
Next lCount
targetCell.Value = vTarget
End Sub
Тестирование:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub test_copy_column()
Dim targetSheet As Worksheet, sourseSheet As Worksheet, LastRow As Long, _
tick As Long
' Maybe change sourseSheet to sourceSheet :)
tick = GetTickCount ' Clock count
Set targetSheet = Sheet1
Set sourseSheet = Sheet1
LastRow = 50000 ' I inputted random numbers for testing
CopyColumn targetSheet, sourseSheet, LastRow
MsgBox "Time to copy: " & GetTickCount - tick & " milliseconds"
End Sub
Результат: 
Соответствующий вопрос SO здесь
Надеюсь, это поможет!
3
23 Май 2017 в 14:57
Большое спасибо! Это отличное решение!
–
26 Май 2014 в 17:03
Для быстрого решения, отличного от VBA, откройте все книги и вставьте следующую формулу во вспомогательный лист:
=first_cell_from_source_workbook + first_cell_from_target_workbook + ...
Скопируйте формулу, чтобы охватить весь диапазон, который вам нужно охватить.
Скопируйте и вставьте специальные-как-значения в целевой диапазон, если вы хотите заменить исходные значения в целевом диапазоне.
Каждый раз, когда вы хотите произвести пересчет, убедитесь, что все исходные книги открыты.
0
26 Май 2014 в 14:42
Спасибо, но это не работает для меня. Документы генерируются автоматически и могут изменяться после этого, и у меня есть много документов, связанных один с другим.
–
26 Май 2014 в 14:52