Schnelle Möglichkeit zum Sortieren von Daten in verschiedene Buckets basierend auf Zellenwert auf der linken Seite

Question

Hier ist das Problem, das ich versuche zu lösen.

Zuerst muss ich eine SQL-Abfrage ausführen. Diese Abfrage gibt Daten mit bis zu 12 Kategorien zurück, die jeweils von der vorherigen abhängig sind. Wenn meine Eingabe beispielsweise "Vereinigte Staaten" lautet, lautet die Spalte 1 "Vereinigte Staaten" und Spalte 2 würde jeden der 50 Staaten enthalten. Spalte drei würde dann alle größeren Städte haben. So erhalten wir etwa 1000 Zeilen, die jeweils mit ‚USA‘ auf der linken Seite, ein Zustand in der Mitte nach oben, und die Stadt, die der Staat in der dritten Spalte ist, wie folgt aus:

United States Texas Austin 
United States Utah Salt Lake City 
United States Nevada Las Vegas 

Was ich Es muss eine programmgesteuerte Datenvalidierung für jede der Kategorien basierend auf dem vorherigen Spaltenwert erstellt werden.

Meine aktuelle Idee ist es, die ursprünglichen Daten zu nehmen, spalten Sie es in zwei Spalten auf einmal auf und entfernen Sie die Duplikate. Dann würde ich die eindeutigen Werte aus Spalte A nehmen und sie oben einfügen und die Daten aus Spalte B in die richtigen Spalten verteilen. Dann würde ich eine Tabelle erstellen und meine Datenüberprüfung auf die Header in der Tabelle überprüfen.

Das Problem kommt hier: Ich kann nicht schnell die Daten aus Spalte B in die richtige Spalte verteilen.

Aus Gründen der Klarheit, das ist, was meine Daten auf jeder Seite mit Ausnahme von Tausenden von Paaren in den Spalten A und B aussieht, und ich muss es schnell in die drei Spalten verteilen.

      Texas  Utah  Nevada 
Texas Austin 
Utah Salt Lake City 
Nevada Las Vegas 

Hier ist, was mit bisher arbeite ich:

Num = 1 
Col = 6 
EndRow = Columns(Col).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
For Col = 6 To 19 
    Set rng = Range(Cells(2, Col), Cells(EndRow, Col)) 
    Unique = CountUnique(rng) 
    If Unique > 1 Then 
    Set rng2 = Sheets("SQL Dump").Range(Cells(2, Col), Cells(EndRow, Col + 1)) 
    rng2.Copy 
    Set ws = Sheets.Add 
    ws.Name = "List" & Num 
    Num = Num + 1 
    ws.Activate 
    Cells(1, 1).PasteSpecial xlPasteAll 
    'MsgBox ("Do Stuff") 
    os.Activate 
    End If 

Next Col 

, so dass es in einzigartige Blätter spaltet wie basierend auf den beiden Säulen benötigt. Wenn jemand einen Weg zur schnellen Sortierung kennt, wäre das sehr zu begrüßen!

Oder wenn Sie einen Weg kennen, um das Problem insgesamt effizienter zu lösen, würde ich das auch gerne hören - danke!

EDIT: CountUnique ist eine Funktion, die ich verwende, um die Anzahl der eindeutigen Werte, die in einer Spalte vorhanden sind, zu zählen.

Answer 1

Dies transponiert Bereiche ziemlich einfach. ist das was du suchst?

Sub TransposeRangeValues() 
    Dim TmpArray() As Variant, FromRange As Range, ToRange As Range 

    Set FromRange = Sheets("Sheet1").Range("a1:c4") 
    Set ToRange = ThisWorkbook.Sheets("Sheet1").Range("a1") 

    TmpArray = Application.Transpose(FromRange.Value) 
    FromRange.Clear 
    ToRange.Resize(FromRange.Columns.Count, FromRange.Rows.Count).Value2 = TmpArray 
End Sub