使用Excel和VBA将logging从重复行移动到列
我有大约70,000行数据和两列（场，数据），每50-100行重复一次（logging）。 我想写一些基于“字段文本”（我只对大约5个字段感兴趣）search值，并将值粘贴到一个新的工作表，其中行logging和列作为字段。 我正在search的第一个字段将需要指示新的行/logging。
我的第一次尝试失败了，我在论坛上找不到什么帮助。 虽然看起来也许是一个数据透视表可以做到这一点？
我想要做什么的视觉： 例子
编辑：
我得到了我想要的结果，但直到“结束”我没有赶上。 我在数据的最后一个单元格中有“END”。 另外，我相信有一个更有效的方法来做到这一点，有什么build议吗？ 谢谢！
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 我认为你的主要问题是增加我两次（通过'结束'单元格）在你的代码的底部。
使其更具可读性的一种方法是使用select case。 而且，由于您有70,000行，因此您可以通过直接赋值（无需复制粘贴）并closures屏幕更新来加快代码速度。 这些东西会大大提高性能。
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
您可能还需要考虑定义工作簿和工作表，而不是依赖活动工作表。 另外，如果有人忘记在最后一个单元格中input'END'，代码将会中断，因此可能只是使用最后一个单元格而不是查找'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