Question

VBA提取字段

如图，请问怎么讲上面表格的内容提取出来，变成下面表格的样式。

Answer 1

因为我本人正在学习VBA ，为了煅炼一下自已，会在网上找些问题然后来练手，针对你的这个问题我的思路如下，供你参考一下。

1，首先将表中第二行，第三行的内容相连起来，然后用Split将他们拆分成数组，

2、新建一个工作表，将分解后的内容赋值到新工作表中，因为表中数值并不是单一对应（有一个对应三个值的情况，例如，23.6BB，第二行只有两个值，但下面相连却要三个数值相加）建议你在原表中最好是做成对应的，像21.5CC 一样，有规则在写代码时就会更容易些），所以将表中重复的23.6BB增加一行，并赋值

3.在新增加的工作表中用字典方法汇总数据，然后赋值。最后形成的图片效果

Sub 提取字段()

Dim ARR, I, cp, cp1, CP2, CP3, ARR1, ARR2, ARR3, arr4, RNG As Range, D As Object

ARR = Sheets(1).[A1].CurrentRegion

For I = 2 To UBound(ARR, 2)

cp = cp & ARR(2, I) & "-"

cp1 = cp1 & ARR(3, I) & "+"

Next

CP2 = Left(cp, Len(cp) - 1)

CP3 = Left(cp1, Len(cp1) - 1)

ARR1 = Split(CP2, "-")

ARR2 = Split(CP3, "+")

For I = 0 To UBound(ARR1)

Sheets(2).Cells(I + 1, 1) = ARR1(I)

Next

Set RNG = Sheets(2).Columns("a:a").Find("23.6BB")

Application.Goto RNG

RNG.Select

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

RNG.Offset(-1, 0).Select

ActiveCell.FormulaR1C1 = "=R[1]C"

For I = 0 To UBound(ARR2)

Sheets(2).Cells(I + 1, 2) = ARR2(I)

Next

arr4 = Sheets(2).[A1].CurrentRegion

Set D = CreateObject("Scripting.Dictionary")

For I = 1 To UBound(arr4)

D(arr4(I, 1)) = D(arr4(I, 1)) + arr4(I, 2)

Next

Sheets(1).[H2].Resize(1, D.Count) = D.KEYS

Sheets(1).[H3].Resize(1, D.Count) = D.ITEMS

End Sub

Answer 2

发到35,8106736

Answer 3

逐对分列，对应的字典累加后输出。

Answer 4

用FIND+LEFT函数就可以了