Excel：将具有相似值的列组合成一个
另一个不是那么容易的问题 使用VBA，我需要迭代具有相似名称的列标题（不精确），并将第一个类中的值分隔开; 。
示例数据：
A (1) B (1) C (1) A (2) B (2) C (2) A(3) B (3) C (3) 15 25 35 45 100 200 300 600 700
应该像这样dynamic地删除多余的列（很多值也是空白的，需要考虑的是：
A (1) B (1) C (1) 15;45;300 25;100;600 35;200;700
编辑：改变数据结构更准确
我猜首先我需要循环和清理数据，所以他们有相同的名称，因为这是唯一的事情相匹配。
For i = 1 to lastCol Step 1 columnVal = ws.Cells(1, i).Value If InStr(columnVal, "(") Then 'Remove everything after first "(" End If For j = 1 to lastCol For k = 1 to lastCol If ws.Cells(1, j).Value = ws.Cells(1, k).Value Then 'Create array with combined values End if Next k Next j
不知道这是否是正确的方法，所以任何帮助表示赞赏
你可以如下所示：
Option Explicit Sub main() With Worksheets("CombineColumns") '<--| change "CombineColumns" to your actual worksheet name With .Range("B2").CurrentRegion '<--| change "B2" to your actual topleftmost cell SortRange .Cells '<-- sort columns by their header .Rows(1).Replace what:="(*)", replacement:="(1)", lookat:=xlPart '<-- make all "similar" header the same Aggregate .Cells '<-- aggregate values under each different unique header End With End With End Sub Sub Aggregate(rng As Range) Dim header As String, resStrng As String Dim iLastCol As Long, iCol As Long With rng header = .Cells(1, 1).Value iCol = 2 iLastCol = 1 resStrng = .Cells(2, 1) Do If .Cells(1, iCol) = header Then resStrng = resStrng & ";" & .Cells(2, iCol) Else .Cells(2, iLastCol).Value = resStrng .Cells(1, iLastCol + 1).Resize(2, iCol - iLastCol - 1).ClearContents iLastCol = iCol resStrng = .Cells(2, iCol) header = .Cells(1, iCol).Value End If iCol = iCol + 1 Loop While iCol <= .Columns.Count .Cells(2, iLastCol).Value = resStrng .Cells(1, iLastCol + 1).Resize(2, iCol - iLastCol - 1).ClearContents .EntireColumn.AutoFit End With End Sub Sub SortRange(rng As Range) With rng.Parent.Sort .SortFields.Clear .SortFields.Add Key:=rng.Rows(1), SortOn:=xlSortOnValues, order:=xlAscending, DataOption:=xlSortNormal .SetRange rng .header = xlYes .MatchCase = False .Orientation = xlLeftToRight .SortMethod = xlPinYin .Apply End With End Sub