另一个不那么容易的问题。使用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
应该是动态的,删除额外的列(很多值也是空白的,需要考虑:
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
不确定这是否是正确的做法,所以感谢任何帮助
答案 0 :(得分:1)
你可以如下:
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