用VBA将特定数据隔离为较大的数据集

Question

我自2000年以来就试图仅隔离西雅图的MSA就业数据，自1990年以来，该国每个MSA的BLS数据集都来自BLS数据集。此数据集中大约有200,000行我需要大约70个。我设法以50秒的运行时间成功删除了所有不必要的数据（不是很好，但对我在做什么）。我的问题是我需要代码是相对的，这意味着每月我想更新它时，我的代码需要每个MSA再容纳一排数据。我接近获取数据的方式是通过分解。首先，我在2000年之前摆脱了所有数据，这将始终具有相同数量的行。然后，我按状态对数据进行了排序。华盛顿靠近过滤列表的尽头，但仍在中间。这意味着我有两个块：

1. 第1行到华盛顿开始的行（现在是第71,556行）
2. 那么华盛顿到达数据结束的地方

我如何才能最有效，准确地计入华盛顿？我愿意完全重组我的数据，我只是不知道如何在VBA中（我是新手）。

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 AnalysisBLS DataData.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

这是我使用过的子，如果我理解您想要的东西，您会发现它有用，它会从表中删除所有行，而这些行不包括一列的给定值：

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

例如：

IsolateDataRows "City", "Washington"