VBA代码做匹配处理
来源:互联网 发布:如何使用网络电视 编辑:程序博客网 时间:2024/06/05 05:22
Public Sub DoFilter2()
' 按照发票号码做匹配,重新生成一个明细的表格,本例子的模板是Sheet9 和 Sheet13
'Sheet9 是明细,Sheet13 是汇总的, 需要从这个两个Sheet里重新提取数据到一个新的Sheet14里
'If Workbooks(1).Worksheets("sheet1") Is Nothing Then
'MsgBox "sheet1不存在"
'Else
'MsgBox "sheet1存在"
'End If
' Sheets("1").Cells.Clear
' Sheets3.Cells.Clear
'Sheets4.Cells.Clear
' Sheets5.Cells.Clear
'第一步:分别对两个sheet按照发票号码进行从小到大排序
Sheet9.Activate
Sheet9RowCount = Sheet9.UsedRange.Rows.Count
Sheet9.Range("A1:U" & Sheet9RowCount).Sort Key1:=Range("D2:D" & Sheet9RowCount), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
'Sheet5.Range("A1:O" & Sheet5RowCount).Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
Sheet13.Activate
Sheet13RowCount = Sheet13.UsedRange.Rows.Count
Sheet13.Range("A1:I" & Sheet13RowCount).Sort Key1:=Range("H2:H" & Sheet13RowCount), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
'Sheet5.Range("A1:O" & Sheet5RowCount).Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
'第二步:Copy Sheet13到 Sheet14里
For i = 1 To Sheet13RowCount
Sheet13.Rows(i).Copy Sheet14.Rows(i)
Next
'第三步:循环Sheet14,按照发票号码到Sheet9里去取相关的信息
Sheet9.Activate
Sheet9ColumnCount = Sheet9.UsedRange.Columns.Count
Sheet13.Activate
Sheet13RowCount = Sheet13.UsedRange.Rows.Count
Sheet14.Activate
Sheet14RowCount = Sheet14.UsedRange.Rows.Count
'如何在excel中把撇号去掉:数据-分列-文本标识符:无,确定即可。
nTitleStartPos = 10 'Sheet14的开始黏贴标题列的位置
For i = 1 To Sheet14RowCount
If i = 1 Then
For j = 1 To Sheet9ColumnCount
Sheet14.Cells(i, nTitleStartPos).Value = Sheet9.Cells(i, j).Value '把Sheet9的抬头拷贝到Sheet14里
nTitleStartPos = nTitleStartPos + 1
Next
Else
strFph = Sheet14.Cells(i, 8).Value
nTitleStartPos = 10
For x = 2 To Sheet9RowCount
If strFph = Sheet9.Cells(x, 4).Value Then '如果有匹配的的发票号码,在从Sheet9里拷贝到Sheet14里
For k = 1 To Sheet9ColumnCount
Sheet14.Cells(i, nTitleStartPos).Value = Sheet9.Cells(x, k).Value '把Sheet9的抬头拷贝到Sheet14里
nTitleStartPos = nTitleStartPos + 1
Next
End If
Next
End If
Next
'第四步:如果在Sheet9里而不在Sheet14里,在Sheet9highlight颜色
'
For k = 2 To Sheet9RowCount
strSheet9Fph = Sheet9.Cells(k, 4).Value
flag = 0
For q = 2 To Sheet14RowCount
If Sheet14.Cells(q, 8).Value = strSheet9Fph Then
flag = 1
End If
Next
If flag = 0 Then
Sheet9.Rows(k).Interior.ColorIndex = 3 ' 背景的颜色为3 红色
End If
Next
'第五步:把金额不等的highlight,如何判断多个相同的发票号来做合计呢
'For i = 2 To Sheet14RowCount
i = 2
Do While (i <= Sheet14RowCount)
j = i + 1
Do While (1)
If Sheet14.Cells(i, 8).Value <> Sheet14.Cells(j, 8).Value Then
'If Sheet14.Cells(i, 6).Value <> Sheet14.Cells(i, 20).Value + Sheet14.Cells(i, 22).Value Then
'Sheet14.Rows(i).Interior.ColorIndex = 3 ' 背景的颜色为3 红色
'End If
'从i到j-1的发票号都是相等的,做求和
myValue = 0
For k = i To j - 1
myValue = myValue + Sheet14.Cells(k, 6).Value
Next
SourceValue = Sheet14.Cells(i, 20).Value + Sheet14.Cells(i, 22).Value
If Val(myValue) <> Val(SourceValue) Then
Sheet14.Rows(i).Interior.ColorIndex = 3 ' 背景的颜色为3 红色
End If
Exit Do
Else
j = j + 1
End If
Loop
i = j
Loop
'Next
'第六步: 把Sheet14里的20列和22列变成明细的值,本来是合计的值
'改成成本价格
For q = 2 To Sheet14RowCount
Sheet14.Cells(q, 20).Value = Sheet14.Cells(q, 6).Value / 1.17 '改成成本价格
Sheet14.Cells(q, 22).Value = Sheet14.Cells(q, 20).Value * 0.17 '用上面的成本价乘以0.17
Sheet14.Cells(q, 16).Value = "'" + CStr(Sheet14.Cells(q, 16).Value) '处理数据的类型,变成字符串
Sheet14.Cells(q, 10).Value = Sheet14.Cells(q, 3).Value
Sheet14.Cells(q, 19).Value = Replace("'" + CStr(Sheet14.Cells(q, 19).Value), "/", "-")
Next
'第七步:删除[作废]行
For q = 2 To Sheet14RowCount
If Sheet14.Cells(q, 9).Value = "作废" Then
Sheet14.Rows(q).Delete
End If
Next
'第八步:删除J列之前全部列
For i = 1 To 9
Sheet14.Columns(1).Delete
Next
End Sub
- VBA代码做匹配处理
- VBA做的一段处理
- VBA处理文件框架代码 【第一部分:处理流程】
- VBA处理文件框架代码 【第三部分:具体处理】
- vba 代码
- VBA处理文件框架代码 【第二部分:变量定义】
- VBA处理文件框架代码 【第四部分:bat定义】
- VBA处理文件框架代码 【第五部分:Excel文件操作】
- VBA处理文件框架代码 【第七部分:程序页面布局】
- VBA处理文件框架代码 【第五部分(5.1.1):具体业务处理代码】
- vba中的查找匹配函数
- 使用python 打开文件并做匹配处理
- 用VBA处理Excel
- VBA字符串处理
- VBA,字符串处理大全
- VBA字符串处理
- VBA中的字符串处理
- VBA 错误处理-过滤
- 互联网协议入门
- poj 1742 Coins
- python操作数据库
- Spring MultipartFile 上传文件文件getInputStream无法获取输入流问题
- 二叉树打印和为某一值的路径
- VBA代码做匹配处理
- 动态规划的求解步骤
- 从输入 URL 到页面加载完成的过程中都发生了什么事情( by vczero)
- 【python学习.用python将数据导入mysql测试】
- matlab中的注释方法
- DNS报文学习
- 乱码文件夹 rm 无法删除...": 没有那个文件或目录
- Android网络通讯之资讯篇
- myeclipse修改乱码(编码格式修改)