Есть предложения или советы, чтобы сделать это лучше? Я использовал его для небольших наборов данных (100-1000 строк), и он отлично работает. Попытка запустить его на наборе данных, содержащем около 100 000 строк, приводит к тому, что во время работы он не отвечает, и мне приходится принудительно выходить из Excel.
Sub CombineSchARecords()
Dim myRow As Long
'Row data starts
myRow = 2
Application.ScreenUpdating = False
'Loop until out of data
Do Until Cells(myRow, "A") = ""
'Check to see if next row is for same filing number
If Cells(myRow, "A") = Cells(myRow + 1, "A") Then
'Add data to correct column
Cells(myRow, "B") = Cells(myRow, "B") & ", " & Cells(myRow + 1, "B") 'SchA-3
Cells(myRow, "C") = Cells(myRow, "C") & ", " & Cells(myRow + 1, "C") 'Schedule
Cells(myRow, "D") = Cells(myRow, "D") & " | " & Cells(myRow + 1, "D") 'Full Legal Name
Cells(myRow, "E") = Cells(myRow, "E") & ", " & Cells(myRow + 1, "E") 'DE/FE/I
Cells(myRow, "F") = Cells(myRow, "F") & ", " & Cells(myRow + 1, "F") 'Entity in Which
Cells(myRow, "G") = Cells(myRow, "G") & ", " & Cells(myRow + 1, "G") 'Title or Status
Cells(myRow, "H") = Cells(myRow, "H") & ", " & Cells(myRow + 1, "H") 'Status Aquired
Cells(myRow, "I") = Cells(myRow, "I") & ", " & Cells(myRow + 1, "I") 'Ownership Code
Cells(myRow, "J") = Cells(myRow, "J") & ", " & Cells(myRow + 1, "J") 'Control Person
Cells(myRow, "K") = Cells(myRow, "K") & ", " & Cells(myRow + 1, "K") 'PR
Cells(myRow, "L") = Cells(myRow, "L") & ", " & Cells(myRow + 1, "L") 'OwnerID
'Then delete row
Rows(myRow + 1).Delete
Else
myRow = myRow + 1 'Move down one row if no match
End If
Loop
Application.ScreenUpdating = True
End Sub
Спасибо!