SERGE_BLIZNUK
Silver Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код:
'В редакторе VBA в меню Tools, пункт Reference
' в диалоге поставте галочку для Microsoft Scripting Runtime.
Sub TestDict()
Dim pAll As New Scripting.Dictionary
Dim w1 As Worksheet
Dim rowLast, iRow As Long
Dim vEntry As String
Set w1 = Workbooks("Книга2.xls").Worksheets("Лист1")
rowLast = Cells(w1.UsedRange.Rows.Count + 1, "A").End(xlUp).Row
' сохраним весь столбец А в Scripting.Dictionary для удобства поиска
For iRow = 1& To rowLast
vEntry = CStr(w1.Cells(iRow, "A").Value)
If Not pAll.Exists(vEntry) Then
pAll.Add vEntry, iRow
End If
Next iRow
' в результате этого кода в Dictionary получаются все уникальные строки из столбца А
...
'вот как их можно все перебрать:
For iRow = 0 To pAll.Count - 1
Cells(iRow + 1, 3).Value = pAll.Keys(iRow)
Cells(iRow + 1, 4).Value = pAll.Items(iRow)
Next iRow
End Sub
|
|
