Zählen eindeutige Textwerte und macht dynamisches Dashboard in VBA

Question

Ich habe eine Referenzdatei für ein Armaturenbrett ich machen werde. Ich möchte die eindeutigen Organisationsnamen in einer Referenzdateispalte zählen und die Anzahl der Spaltenüberschriften in meinem separaten Dashboard festlegen können. Ich habe Makrorecorder verwendet, um es einzigartig zu machen, aber ich bin mir nicht sicher, wie ich das umsetzen kann, um eine dynamische Anzahl von Spalten für mein Dashboard zu erstellen, basierend auf der Anzahl der eindeutigen Organisationsnamen in der Ref-Datei. Hier sehen Sie ein Beispiel für einen Bildanhang, wie die Referenzdatei aussehen könnte. Also, wenn es zählt, dass es 5 eindeutige Namen gibt, möchte ich das separate Dashboard, um 5 Spalten mit diesen Namen als Kopfzeilen in jeder Spalte zu machen.

Sub Macro1() 


'  Macro1 Macro 

Columns("F:F").Select 
Range("F1:F10000000000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns _ 
    ("O:O"), Unique:=True 

ActiveCell.FormulaR1C1 = "=ROWS(R[-11]C:R[-2]C)" 

End Sub 

Answer 1

Hier ist eine Möglichkeit, dies zu tun, indem die eindeutigen Ergebnisse in ein Array geladen werden. Dies setzt voraus, dass die Spaltenüberschriften in A1 gehen.

Sub Macro1() 

Dim wsRef As Worksheet 
Dim wsDB As Worksheet 

Set wsRef = Worksheets("reference") 
Set wsDB = Worksheets("Dashboard") 

With wsRef 
    .Range("C1:C9").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("F1"), Unique:=True 

    Dim arrValues As Variant 
    arrValues = .Range("F2", .Range("F" & .Rows.Count).End(xlUp)) 

End With 

With wsDB 
    .Range(.Range("A1"), .Cells(1, UBound(arrValues))).Value = Application.WorksheetFunction.Transpose(arrValues) 
End With 

End Sub 

Answer 2

ein Dictionary object Verwenden Sie Ihre eindeutige Werte zu erhalten, dann Schleife durch die Wörterbuchelemente auf Ihre Spaltenüberschriften zu machen. zB

myCol = 1 
For Each item in oDic.items 
    'Presuming you want your headers to start at A1 
    Cells(1, myCol).Value = item 
    myCol = myCol + 1 
Next