Bu soru onu görene kadar bile COLLECT() fonksiyonun duymamıştım, ama çok kullanışlı görünüyor. Okuduklarıma dayanarak, aşağıdakilerin Excel çalışma sayfanızı web_link sütununu toplarken benzersiz satırlara indirmesi gerektiğini düşünüyorum. Anında bunu yapmayacaktır (aradığınız şey bu olabilir), ancak veriler bir kere orada olduğunda tüm sayfa üzerinde çalıştırabilirsiniz.
Public Type Entry
C_IP As String
rowNum As Integer
End Type
Public entryList() As Entry
Sub AggregateRows()
Dim lastRow As Integer
Dim i As Integer
Dim webLinks As String
Dim entryItem As Entry
Const C_IPColumn As Integer = 1 ' This is the column number of the C_IP column
Const WEB_LINKColumn As Integer = 6 ' This is the column number of the WEB_LINK column
ReDim entryList(0)
' Get the last used row on the sheet
lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
' Loop through all of the rows
For i = 1 To lastRow
' See if we've already encountered the C_IP in this row
entryItem = GetEntry(ActiveSheet.Cells(i, C_IPColumn).Value)
If Not entryItem.C_IP = "" Then
' We have, so add the current web link to the list for the row associated with this C_IP
webLinks = ActiveSheet.Cells(entryItem.rowNum, WEB_LINKColumn).Value
webLinks = webLinks & ", " & ActiveSheet.Cells(i, WEB_LINKColumn).Value
ActiveSheet.Cells(entryItem.rowNum, WEB_LINKColumn).Value = webLinks
' Now remove this row (since it has been grouped with row with the same C_IP)
ActiveSheet.Rows(i).Delete
' Decrement our counters by 1 since we have 1 fewer rows (assuming we're not on the last row already)
If Not i = lastRow Then
i = i - 1
lastRow = lastRow - 1
End If
Else
' We've not encountered this C_IP yet, so add it to the list
ReDim Preserve entryList(UBound(entryList) + 1)
entryList(UBound(entryList)).C_IP = ActiveSheet.Cells(i, C_IPColumn).Value
entryList(UBound(entryList)).rowNum = i
End If
Next i
End Sub
' Returns the Entry matching the passed-in C_IP
Function GetEntry(C_IP As String) As Entry
Dim i As Integer
' Loop through all stored entries and return the first whose C_IP matches that passed in
For i = 0 To UBound(entryList)
If entryList(i).C_IP = C_IP Then
GetEntry = entryList(i)
End If
Next i
End Function
' A quick and dirty way to get an empty Entry
Function GetEmptyEntry() As Entry
End Function