Я уверен, что это действительно легко исправить.В настоящее время у меня есть таблица Excel с двумя листами.Первый - это лист с учетными записями в столбце A, пространство для количества хостов в столбце B, а затем остальные столбцы справа - это группы, к которым у учетной записи есть доступ.На другом листе у меня есть 2 столбца данных, первый столбец является хостом, а второй столбец является группой.Я пытаюсь подсчитать количество хостов, связанных с данной учетной записью, для каждой учетной записи в первом листе.
Поскольку хосты могут быть в нескольких группах, а учетная запись может быть связана с несколькими группами, можнобыть дубликатами хостов, учитываемых для учетной записи.Я попытался создать макрос, который бы проходил по первому листу, получал значение группы, а затем переходил на второй лист и помещал все имена хостов для этой группы в массив.Он будет делать это для каждой группы и добавлять хосты в конец массива, пока не достигнет конца списка групп для данной учетной записи.Затем мой макрос использует функцию для удаления дубликатов из массива, а затем помещает счетчик массива в ячейку в столбце b на листе 1.
Чтобы создать этот массив, я собирал кусочки извещи, которые я нашел на этом сайте, но я думаю, что я что-то напутал.Макрос заканчивает тем, что помещает одно и то же число в столбец b независимо от того, какие группы связаны с учетной записью.
Мой код указан ниже:
Sub PopulatingArrayVariable()
'PURPOSE: Dynamically Create Array Variable based on a Given Size
Dim myArray As Variant
Dim arr2() As Variant
Dim myString As String
Dim x As Long
Dim r As Long
Dim d As Variant
Dim row As Integer
Dim Group As String
Dim endRow As Long
For i = 2 To 5
Worksheets("Sheet1").Activate
For Each c In Worksheets("Sheet1").Range("C2:I2").Cells 'Finds the group the account belongs to and loops through each of them
'For c = 3 To 8
Group = c.Value
Worksheets("Sheet2").Activate
endRow = 14 ' of course it's best to retrieve the last used row number via a function
For r = 1 To endRow
If Cells(r, Columns("B").Column).Value = Group Then 'adds each host in the group into an array
myString = myString & ";|;" & Cells(r, 1).Value
End If
Next r
Next 'c
'Remove first delimiter from string (;|;)
myString = Right(myString, Len(myString) - 3)
'Create an array with the Split() function
myArray = Split(myString, ";|;")
arr2 = RemoveDupesColl(myArray)
Dim lNumElements As Long
lNumElements = UBound(arr2) - LBound(arr2) + 1
Worksheets("Sheet1").Cells(i, 2).Value = lNumElements
myString = Empty
Next i
'Print values to Immediate Window (Ctrl + G to view)
'For x = LBound(myArray) To UBound(myArray)
' Debug.Print myArray(x)
' Next x
End Sub
, а вот функция удаления дубликатов:
Function RemoveDupesColl(myArray As Variant) As Variant
'DESCRIPTION: Removes duplicates from your array using the collection method.
'NOTES: (1) This function returns unique elements in your array, but
' it converts your array elements to strings.
'SOURCE: https://wellsr.com
'-----------------------------------------------------------------------
Dim i As Long
Dim arrColl As New Collection
Dim arrDummy() As Variant
Dim arrDummy1() As Variant
Dim item As Variant
ReDim arrDummy1(LBound(myArray) To UBound(myArray))
For i = LBound(myArray) To UBound(myArray) 'convert to string
arrDummy1(i) = CStr(myArray(i))
Next i
On Error Resume Next
For Each item In arrDummy1
arrColl.Add item, item
Next item
Err.Clear
ReDim arrDummy(LBound(myArray) To arrColl.Count - LBound(myArray) - 1)
i = LBound(myArray)
For Each item In arrColl
arrDummy(i) = item
i = i + 1
Next item
RemoveDupesColl = arrDummy
End Function
Может кто-нибудь помочь мне разобраться, как заставить это работать или помочьменя с более эффективным макросом, так как в конечном итоге я буду использовать его для нескольких тысяч учетных записей, более 100 групп и более 10000 хостов.
Спасибо