我有一张大约有2000行的Excel表格 .
-
因此第1行是第一个 Headers ,列是:唯一名称,长度,高程 . 然后有一堆与这些列相关的数据 .
-
第8行是另一个 Headers ,列是:唯一名称,高程,元素类型 . 这些列后面还有一些数据 .
-
依此类推Excel表格中有许多这样的行是 Headers .
这些标头的顺序不同 . 以下是Excel Sheet1的示例:
Unique Name Length (ft) Elevation (ft) this is Row 1 (header1)
A 20 4 this is Row 2
B 5 10 this is Row 3
C 10 3
D 11 40
E 3 60
Row 7 is blank
Unique Name Elevation (ft) Element Type this is Row 8 (header2)
1 20 Pipe
2 5 Pipe
3 10 Pipe
Row 12 is blank
Unique Name Element Type Elevation Status this is Row 13 (header 3)
A1 VALVE 10 Open
A2 VALVE 2 Open
A3 VALVE 100 Open
. . . .
. . . .
. . . .
. . . .
我需要根据特定标头复制Sheet1中的每一列数据并将其粘贴到Sheet2 .
这是Sheet2的一个例子,这就是我需要的:
Unique Name Length (ft) Elevation (ft) Status Element Type this is the only header I need
A 20 4
B 5 10
C 10 3
D 11 40
E 3 60
1 20 Pipe
2 5 Pipe
3 10 Pipe
A1 10 Open VALVE
A2 2 Open VALVE
A3 100 Open VALVE
. . . . .
. . . . .
. . . . .
. . . . .
我搜索了很多,下面的Alex的VBA代码是我在这个帮助论坛中找到的最接近的代码 . 但它显然只适用于属于第1行 Headers 的数据 .
Sub CopyPasteData()
Dim header As Range, headers As Range
Set headers = Worksheets("Sheet1").Range("A1:Z1")
For Each header In headers
If GetHeaderColumn(header.Value) > 0 Then
Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("Sheet2").Cells(2, GetHeaderColumn(header.Value))
End If
Next
End Sub
Function GetHeaderColumn(header As String) As Integer
Dim headers As Range
Set headers = Worksheets("Sheet2").Range("A1:Z1")
GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)),
Application.Match(header, headers, 0), 0)
End Function
谢谢 .
1 回答
如果您可以关闭第一列中的“唯一名称”作为指示已达到新 Headers ,那么应该很容易做到 . 您基本上只需要跟踪3个不同的映射 - 已经找到的 Headers 列,已经找到的唯一名称的行,以及当前部分中 Headers 的位置 .
Microsoft Scripting Runtime中的字典适用于此 . 像这样的东西应该做的伎俩: