Как делать не надо:)

[SSecurity]

нашел тут на одном сайте код, который потряс ресурсоемкостью и ошибками ))

Код: Выделить всё

Private Sub CommandButton1_Click()
Dim MyPath As String 'Путь
Dim MyFileName As String 'Название файл(ов) которые мы будем открывать
Dim MyFileName_ As String 'Название файл(ов) которые мы будем открывать
Dim ID() As Integer 'Массив ID которые по которым мы будет собирать данные
Dim KolID As Integer
Dim KolCells As Integer 'Количество строчек по которым мы будет искать данные
Dim KolRows As Integer 'Количество столбцов по которым мы будет искать данные
Dim ICells As Integer, JCells As Integer, ICellsID ' Счетчикu для цикла
Dim WorkMas() As String
Dim MasStat() As Integer
MyPath_ = "C:\bd\"
MyPath = "C:\xls\"
MyFile = Application.GetOpenFilename("(*.xls),*.xls")
MyFileName = MyFile 'Пишем имя файла в ктором храняться ID
Workbooks.Open(MyFileName).Activate 'Открываем нужную нам книгу
With ActiveWorkbook.ActiveSheet
KolCells = .Cells(1, 1).End(xlDown).Row
KolID = KolCells
ReDim ID(KolCells)
For ICells = 1 To KolCells
ID(ICells) = .Cells(ICells, 1)
' все что есть в первом столбце заносим в массив
Next ICells
End With
ActiveWindow.Close 'Закрываем книгу

MyFileName_ = "BD.xls" 'Пишем имя файла базы данных
Workbooks.Open(MyPath_ & "\" & MyFileName_).Activate 'Открываем нужную нам книгу
With ActiveWorkbook.ActiveSheet
KolCells = .Cells(1, 1).End(xlDown).Row
KolRows = .Cells(1, 1).End(xlToRight).Column
ReDim WorkMas(KolCells, KolRows)
For ICells = 1 To KolCells
For ICellsID = 1 To KolID
If .Cells(ICells, 1) = ID(ICellsID) Then
For JCells = 1 To KolRows
WorkMas(ICells, JCells) = .Cells(ICells, JCells)

' Если тут есть нужный нам ID то заносим его в память
Next JCells
End If
Next ICellsID
Next ICells
End With
ActiveWindow.Close 'Закрываем книгу
' Все что нам надо у нас есть в памяти=))
'Все что есть выводим
ReDim MasStat("20")
For ICells = 1 To KolID
For JCells = 1 To KolRows

If WorkMas(ICells, JCells) = "Значение1" Then MasStat(1) = MasStat(1) + 1
If WorkMas(ICells, JCells) = "Значение2" Then MasStat(2) = MasStat(2) + 1
Cells(ICells, JCells) = WorkMas(ICells, JCells)

Next JCells
Next ICells

End Sub