Hello，我又双叒叕来了，这次是清单计价表的数据高速处理的一种方法，有时候我们收到别人软件导出的清单计价表，然后我们需要用它进行价格的填写，以及分部分项进行汇总；那么有时数据不多，但有时候数据密密麻麻密密，上千行数据，如果一个一个进行填写的话是不是很麻烦呢？
当然可以用Vlookup函数公式来进行统计，再用函数公式分别填入单价；但是软件导出的表格每一页都有一个表头，而表头的单元格是合并的，我们都知道单元格在下拉的时候遇到大小不同的合并单元格就会出现拉不走的情况；这时候VBA就派上用场了，我们来看一下用VBA做这件事的步骤：
下面是图文描述▼
预览------上图可以看到，数据也就三百多项而已。
步骤 1 ▼
提取
这里对计价表中的名称、项目特征描述里的规格型号或者材质进行提取，我们选中表格的上一行直接下拉至结束，内容自动提取，具体应用如下：
函数公式一，提取文字▼
=TRIM(MID(SUBSTITUTE(配电工程!D6,CHAR(10),REPT(" ",100)),100,99))
这个函数公式实现对单元格内的多行文本的第二行文字提取。
函数公式二，提取指定字符▼
=IFERROR(IF(FIND("型号",G6),RIGHT(G6,LEN(G6)-FIND("型号",G6)+1)),"")&IFERROR(IF(FIND("材质",G6),RIGHT(G6,LEN(G6)-FIND("材质",G6)+1)),"")&IFERROR(IF(FIND("规格",G6),RIGHT(G6,LEN(G6)-FIND("规格",G6)+1)),"")
这个函数公式实现只提取含有型号、材质、规格的文字。
函数公式三：提取名称并合并规格型号▼
=IF(IF(AND(I6<>"",G6<>""),配电工程!C6&H6&I6,IFERROR(MID(配电工程!D6,FIND(":",配电工程!D6)+1,FIND(CHAR(10),配电工程!D6)-1-FIND(":",配电工程!D6)),LEFT(配电工程!D6,FIND(CHAR(10),配电工程!D6&CHAR(10))-1)))="项目特征描述","",IF(AND(I6<>"",G6<>""),配电工程!C6&H6&I6,IFERROR(MID(配电工程!D6,FIND(":",配电工程!D6)+1,FIND(CHAR(10),配电工程!D6)-1-FIND(":",配电工程!D6)),LEFT(配电工程!D6,FIND(CHAR(10),配电工程!D6&CHAR(10))-1))))
该函数公式提取项目特征描述里的名称，合并上一步骤提取的指定字符。
VBA：一键删除重复值▼
Sub 去重复提取()Range("F6:F336").SelectSelection.Copy'选中F6:F336区域并复制 ActiveWindow.SmallScroll Down:=-18 Range("C6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Range("$C$5:$C$336").RemoveDuplicates Columns:=1, Header:=xlYes ActiveWorkbook.Worksheets("参数设置").Sort.SortFields.Clear '选中C5:c336并去重复With ActiveWorkbook.Worksheets("参数设置").Sort.SetRange Range("C5:C336") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End WithActiveWindow.SmallScroll Down:=-9End Sub
利用VBA实现一键对上一步骤中提取的全部项进行去重复处理。
步骤 2 ▼
汇总
同样的选中第一行单元格，下拉就完成汇总，然后填入每一项的单价就可以了。
步骤 3 ▼
填价
这里利用VBA自动根据汇总表的分部分项单价进行查找匹配，将对应的价格填入到清单计价表的单价中，VBA代码如下：
Sub 填入单价()
Dim arr, d As Object
Dim lr&, i&, j%
With Sheets("汇总表")
arr = .Range("A5:I" & .Range("E65536").End(xlUp).Row - 1)
End With
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 1) & arr(i, 5)) Then d(arr(i, 1) & arr(i, 5)) = arr(i, 7) & Chr(9) & arr(i, 9) 'i1和i5为A列和E列，i,7为汇总表A列起第7列，即G列（单价）
Next
lr = Range("E65536").End(xlUp).Row - 1
arr = Range("A1:K" & Range("A65536").End(xlUp).Row - 1)
For i = 1 To UBound(arr)
If d.exists(arr(i, 1) & arr(i, 5)) Then '此处i1和i5为计价表第1列和第5列
For j = 8 To 8
If Not Cells(i, j).HasFormula Then Cells(i, j) = Split(d(arr(i, 1) & arr(i, 5)), Chr(9))(j - 8) 'i,1和i,5为清单计价表第1列（A列）和第5列（E列）与第9行i1和i5匹配，填入i,7（既第9行-汇总表G列值）到j-8（计价表第8列）
Next End If
Next
End Sub
（注：上一段代码由Excelhome论坛-VBA程序开发-离任版主-回帖代码进行移植修改而来，原帖地址：http://club.excelhome.net/thread-489194-1-1.html）
需要下载文中Excel文件的朋友请点击：下载专区
