0

我有大约 70,000 行数据和两列（字段，数据），每 50-100 行重复一次（记录）。我想写一些东西来搜索基于“字段文本”的值（我只对大约 5 个字段感兴趣）并将值粘贴到一个新的工作表中，其中行作为记录，列作为字段。我要搜索的第一个字段需要指明新的行/记录。

我的第一次尝试失败了，我在论坛上几乎找不到帮助。虽然看起来也许数据透视表可以做到这一点？

我想做的事情的视觉： 示例

编辑：

我得到了我想要的结果，但直到“END”没有捕捉到。我在数据的最后一个单元格中有“END”。另外，我确信有一种更有效的方法可以做到这一点，有什么建议吗？谢谢！

Sub TracePull()

Dim i As Long
Dim j As Long

i = 1
j = 1

ActiveWorkbook.Sheets("Trace").Range("A1").Select

Do Until Range("A" & i) = "END"

Do Until ActiveCell = "OTDRFilename"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRFilename" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("A" & j + 1).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
    j = j + 1
'Else
'    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRSpan length"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRSpan length" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("B" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRSpan loss"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRSpan loss" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("C" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRAverage loss"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRAverage loss" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("D" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRSpan ORL"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRSpan ORL" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("E" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRWavelength"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRWavelength" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("F" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

i = i + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select

Range("A" & i).Select

Loop

End Sub
4

1 回答 1

2

我认为您的主要问题是在代码底部将 i 递增两次（通过 'END' 单元格）。

使其更具可读性的一种方法是使用 select case。此外，您可以通过直接分配值（无需复制粘贴）和关闭屏幕更新来加速代码，因为您有 70,000 行。这些东西将大大提高性能。

Sub TracePull()

  ScreenUpdating = False

  Dim i As Long
  Dim j As Long

  i = 1
  j = 1

  ActiveWorkbook.Sheets("Trace").Range("A1").Select

    Do Until Range("A" & i) = "END"
      Select Case ActiveCell.Text
        Case "OTDRFilename"
          ActiveWorkbook.Sheets("Sheet1").Range("A" & j + 1).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value

        Case "OTDRSpan length"
          ActiveWorkbook.Sheets("Sheet1").Range("B" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value

        Case "OTDRSpan loss"
          ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value

        Case "OTDRAverage loss"
          ActiveWorkbook.Sheets("Sheet1").Range("D" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value

        Case "OTDRSpan ORL"
          ActiveWorkbook.Sheets("Sheet1").Range("E" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value

        Case "OTDRWavelength"
          ActiveWorkbook.Sheets("Sheet1").Range("F" & j).Value = ActiveWorkbook.Sheets("Trace").Range("B" & i).Value
        End Select

      i = i + 1
      j = j + 1
      ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    Loop
    ScreenUpdating = True
End Sub

您可能还需要考虑定义工作簿和工作表，而不是依赖于活动表。此外，如果有人忘记在最后一个单元格中输入“END”，则带有 break 的代码，所以也许只是使用最后一个单元格而不是寻找“END”

  Dim wb As Workbook
  Dim wskA As Worksheet
  Dim wskB As Worksheet

  wb = ActiveWorkbook
  wskA = wb.Sheets("Trace")
  wskB = wb.Sheets("Sheet1")

  numofrows = wskA.Offset(wskA.Rows.Count - 1, 0).End(xlUp).Row
  wskA.Range("A1").Select

    Do Until i > numofrows
      Select Case ActiveCell.Text
        Case "OTDRFilename"
          wskB.Range("A" & j + 1).Value = wskA.Range("B" & i).Value
于 2013-10-06T16:04:44.397 回答