Isolierung spezifischer Daten aus einem größeren Datensatz mit VBA

Question

Ich versuche seit dem Jahr 2000 nur Seattle MSA Beschäftigungsdaten aus dem BLS-Datensatz von jedem einzelnen MSA im Land zu isolieren. Es gibt ungefähr 200.000 Zeilen in diesen Daten Set und alles, was ich brauche, sind etwa 70 von ihnen. Ich habe es geschafft, alle unnötigen Daten mit einer Laufzeit von 50s erfolgreich zu löschen (nicht großartig, aber gut für das, was ich mache). Mein Problem ist, dass ich brauche, dass der Code relativ ist, was bedeutet, dass ich jeden Monat, wenn ich den Code aktualisieren möchte, eine weitere Zeile Daten pro MSA aufnehmen muss. Die Art, wie ich an die Daten herangekommen war, war Chunking. Zuerst habe ich alle Daten vor 2000 gelöscht, einfach wird das immer die gleiche Anzahl von Zeilen haben. Dann habe ich die Daten nach Zustand sortiert. Washington ist nahe am Ende der gefilterten Liste, aber immer noch in der Mitte. Das bedeutet, ich habe zwei Stücke:

1. Zeile 1 auf die Zeile, in Washington beginnt dann
2. (jetzt, dass 71.556 ist Zeile), wo Washington bis zum Ende der Daten endet

Wie kann ich am effizientesten und genauesten nach Washington zählen? Ich bin offen für die Umstrukturierung meiner Daten, ich habe einfach keine Ahnung, wie in VBA (ich bin neu).

Sub FillDataBLS() 

' 
' FillDataBLS Macro 
' Fills data from BLS that has been save as Data.csv in the BLS Data folder. 
' 
Application.ScreenUpdating = False 
Application.EnableEvents = False 

With ActiveSheet.QueryTables.Add(Connection:= _ 
    "TEXT;Z:\Seattle Office Market Analysis\BLS Data\Data.csv",  Destination:= _ 
    range("$A$1")) 
    .Name = "Data" 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = False 
    .RefreshStyle = xlInsertDeleteCells 
    .SavePassword = False 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .TextFilePromptOnRefresh = False 
    .TextFilePlatform = 437 
    .TextFileStartRow = 1 
    .TextFileParseType = xlDelimited 
    .TextFileTextQualifier = xlTextQualifierDoubleQuote 
    .TextFileConsecutiveDelimiter = False 
    .TextFileTabDelimiter = True 
    .TextFileSemicolonDelimiter = False 
    .TextFileCommaDelimiter = True 
    .TextFileSpaceDelimiter = False 
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) 
    .TextFileTrailingMinusNumbers = True 
    .Refresh BackgroundQuery:=False 
End With 

'Sets font style and size' 
With range("A1").CurrentRegion.Font 
    .Size = 10 
    .FontStyle = "Book Antiqua" 
End With 

'Removes blank rows above header' 
Rows("1:2").EntireRow.Delete 
Rows(2).EntireRow.Delete 

'Remove years 1990-1999' 
firstRow = 2 
lastRow = 47281 
Rows("2:47281").EntireRow.Delete 'this will always be the same length 


'Sort by State FIPS Code and delete all but 53' 
range("A1").CurrentRegion.Sort Key1:=range("B2"), Order1:=xlAscending 
firstRow = 1 
'lastRow 
Rows("1:71556").EntireRow.Delete 'find a way to count these rows specifically 
'firstRow 
'lastRow 
Rows("2212:7638").EntireRow.Delete 'find a way to count these rows specifically 

'Finds only Seattle MSA data' 
k = 2211 
j = 1 'for the quarterly' 
For i = k To 1 Step -1 
    If Cells(i, 1).Value = "MT5342660000000" Then 
     Cells(i, 8).Font.Bold = True 
    Else 
     Rows(i).EntireRow.Delete 
    End If 
Next i 

'Sets up Column Titles' 
range("A1").CurrentRegion.Sort Key1:=range("A1"), Order1:=xlAscending 
Rows(1).Font.Bold = True 
Rows(1).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDouble 

End Sub 

Answer 1

Hier ist ein Unter ich mich benutzt, wenn ich verstehe, was Sie richtig wollen Sie es für sinnvoll, löscht er alle Zeilen aus dem Blatt, das den gegebenen Wert einer Spalte nicht enthalten:

Sub IsolateDataRows(dataHeader As String, sData As String) 
    Dim valueColumn As Long, valueRow As Long, count As Long 
    Dim tCell As Range 
    Dim ws As Worksheet: Set ws = ActiveWorkbook.ActiveSheet 

    ' find data column 
    Set tCell = ws.Rows(1).Find(what:=dataHeader, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False) 
    valueColumn = tCell.Column 

    ' sort sheet by wanted column 
    ws.Columns("A:D").Sort key1:=ws.Columns(valueColumn), _ 
    Order1:=xlAscending, header:=xlYes, Orientation:=xlTopToBottom 

    ' find data's first occurance 
    Set tCell = ws.Columns(valueColumn).Find(what:=sData, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False) 
    valueRow = tCell.row 

    ' get count of data occurances 
    count = Application.CountIf(ws.Columns(valueColumn), sData) 

    ' delete rows before and after your data 
    ws.Rows(valueRow + count & ":" & ws.Rows.count).EntireRow.Delete 
    If valueRow > 2 Then ws.Rows("2:" & valueRow - 1).EntireRow.Delete 
End Sub 

Zum Beispiel:

IsolateDataRows "City", "Washington"