VBA代码做匹配处理



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