Question

自1990年以来，我试图仅将西雅图MSA就业数据与该国每一个MSA的BLS数据集隔离开来。该数据集中大约有200,000行，我只需要其中的70行。我已经设法成功删除所有不必要的数据，运行时间为50秒（不是很好，但我正在做的很好）。我的问题是我需要代码是相对的，这意味着每个月我想更新它时，我的代码需要为每个MSA容纳一行数据。我接近获取数据的方式是通过分块。首先，我在2000年之前摆脱了所有数据，这很容易就会有相同的行数。然后我按州排序数据。华盛顿接近已过滤列表的末尾，但仍处于中间位置。这意味着我有两个块：

第1行到华盛顿开始的行（现在是第71,556行）
然后华盛顿结束到数据结束

我如何才能最有效，最准确地计入华盛顿？我完全可以重构我的数据，我只是不知道如何在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 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

这是我自己使用的一个子，如果我理解你想要的东西你会觉得它很有用，它会删除工作表中不包含给定列值的所有行：

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"

使用VBA

1 个答案: