excel宏程序实例
在同一个表格比较：以I为准，如果J存在有I的内容则I为"OK"
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j
For i = 2 To 25
For j = 2 To 38
If Trim(Cells(i, 6)) = Trim(Cells(j, 4)) Then
Cells(i, 7) = "ok"
Cells(j, 5) = "ok"
Exit For
End If
Next
Next
End Sub
两个不同的表格比较：以I为准，如果J存在有I的内容则I为"OK"
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 25
For j = 2 To 25
If Trim(Cells(i, 1)) = Trim(Sheet2.Cells(j, 4)) Then
Cells(i, 2) = "ok"
Sheet2.Cells(j, 5) = "ok"
Exit For
End If
Next
Next
End Sub
唯一性比较程序:同一列内是否唯一。运行没有成功
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 1 To 15
If Trim(Cells(i + 1, 3)) = Trim(Cells(i, 3)) Then
Cells(i, 4) = "重复"
Cells(i + 1, 4) = "重复"
End If
Next
End Sub
合并计算程序：把当前表中的以I列相同的
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J As Long
Dim s As Double
s = 0
J = 2
For I = 2 To 17780
If Cells(I, 3) <> Cells(I + 1, 3) Then
Cells(I + 1, 11) = "ok"
End If
Next
For I = 2 To 17780
If Cells(I, 11) = "ok" Then
Sheet3.Cells(J, 1) = "合计"
Sheet3.Cells(J, 2) = Cells(I-1, 2)
Sheet3.Cells(J, 3) = Cells(I-1, 3)
Sheet3.Cells(J, 4) = Cells(I-1, 4)
Sheet3.Cells(J, 10) = s
s = 0
J = J + 1
End If
Sheet3.Cells(J, 1) = Cells(I, 1)
Sheet3.Cells(J, 2) = Cells(I, 2)
Sheet3.Cells(J, 3) = Cells(I, 3)
Sheet3.Cells(J, 4) = Cells(I, 4)
Sheet3.Cells(J, 5) = Cells(I, 5)
Sheet3.Cells(J, 6) = Cells(I, 6)
Sheet3.Cells(J, 7) = Cells(I, 7)
Sheet3.Cells(J, 8) = Cells(I, 8)
Sheet3.Cells(J, 9) = Cells(I, 9)
Sheet3.Cells(J, 10) = Cells(I, 10)
s = s + Cells(I, 10)
J = J + 1
Next
End Sub
差异分析，移动相同数据到另外一张表
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 1958
For j = 4 To 1971
If Trim(Cells(i, 3)) = Trim(Sheet2.Cells(j, 7)) Then
Cells(i, 6) = "ok"
Sheet2.Cells(j, 9) = Cells(i, 4)
Sheet2.Cells(j, 10) = Cells(i, 5)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 1 To 3669
For j = 2 To 4443
If Trim(Cells(i, 1)) = Trim(Sheet2.Cells(j, 5)) Then
Cells(i,
3) = "ok"
Sheet2.Cells(j, 3) = Cells(i, 2)
Sheet2.Cells(j, 7) = Cells(i, 1)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 4443
For j = 2 To 38
If Trim(Cells(i, 1)) = Trim(Sheet2.Cells(j, 9)) Then
Cells(i, 2) = "ok"
Sheet2.Cells(j, 4) = Cells(i, 5)
Sheet2.Cells(j, 6) = Cells(i, 4)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 1 To 2536
If Trim(Cells(i + 1, 1)) = Trim(Cells(i, 1)) Then
Cells(i, 2) = "重复"
Cells(i + 1, 2) = "重复"
End If
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 4445
For j = 2 To 1949
If Trim(Cells(i, 1)) = Trim(Sheet1.Cells(j, 1)) Then
Cells(i, 3) = "ok"
Sheet1.Cells(j, 3) = Cells(i, 2)
Sheet1.Cells(j, 4) = Cells(i, 1)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 1112
For j = 3 To 1112
If Trim(Cells(i, 35)) = Trim(Sheet7.Cells(j, 33)) Then
Cells(i, 2) = "ok"
Sheet7.Cells(j, 1) = Cells(i, 3)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 4 To 723
For j = 3 To 3198
If Trim(Cells(i, 1)) = Trim(Sheet6.Cells(j, 1)) Then
Cells(i, 2) = "ok"
Sheet6.Cells(j, 2) = Cells(i, 1)
Sheet6.Cells(j, 3) = Cells(i, 6)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 708
For j = 3 To 725
If Trim(Cells(i, 1)) = Trim(Sheet2.Cells(j, 1)) Then
Cells(i, 2) = "ok"
Sheet2.Cells(j, 2) = "ok"
Sheet2.Cells(j, 6) = Cells(i, 15)
Sheet2.Cells(j, 7) = Cells(i, 17)
Sheet2.Cells(j, 9) = Cells(i, 29)
Sheet2.Cells(j, 10) = Cells(i, 31)
Sheet2.Cells(j, 11) = Cells(i, 12)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 1454
For j = 2 To 5162
If Trim(Cells(i, 2)) = Trim(Sheet2.Cells(j, 29)) Then
Cells(i, 9) = "ok"
Sheet2.Cells(j, 1) = Cells(i, 6)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 1 To 102
For j = 1 To 1550
If Trim(Cells(i, 2)) = Trim(Sheet6.Cells(j, 29)) Then
Cells(i, 9) = "ok"
Sheet6.Cells(j, 1) = Cells(i, 6)
Sheet6.Cells(j, 2) = Cells(i, 6)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 1 To 102
For j = 1 To 1451
If Trim(Cells(i, 1)) = Trim(Sheet4.Cells(j, 1)) Then
Cells(i, 9) = "ok"
Sheet4.Cells(j, 2) = Cells(i, 1)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 4955
For j = 3 To 56
If Trim(Cells(i, 4)) = Trim(Sheet3.Cells(j, 29)) Then
Cells(i, 5) = "ok"
Sheet3.Cells(j, 5) = Cells(i, 2)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 4955
For j = 3 To 851
If Trim(Cells(i, 4)) = Trim(Sheet2.Cells(j, 30)) Then
Cells(i, 5) = "ok"
Sheet2.Cells(j, 1) = Cells(i, 3)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 824
For j = 2 To 1281
If Trim(Cells(i, 1)) = Trim(Sheet5.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Sheet5.Cells(j, 3) = Cells(i, 5)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 1375
For j = 2 To 1983
If Trim(Cells(i, 1)) = Trim(Sheet7.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Sheet7.Cells(j, 3) = Cells(i, 4)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 1669
For j = 2 To 2078
If Trim(Cells(i, 1)) = Trim(Sheet7.Cells(j, 2)) Then
Cells(i, 4) = "ok"
Sheet7.Cells(j, 3) = Cells(i, 5)
Cells(i, 7) = Sheet7.Cells(j, 7)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 264
For j = 2 To 463
If Trim(Cells(i
, 1)) = Trim(Sheet4.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Sheet4.Cells(j, 3) = Cells(i, 5)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 647
For j = 2 To 851
If Trim(Cells(i, 1)) = Trim(Sheet4.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Sheet4.Cells(j, 3) = Cells(i, 5)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 963
For j = 2 To 987
If Trim(Cells(i, 1)) = Trim(Sheet5.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Sheet5.Cells(j, 3) = Cells(i, 5)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 6320
For j = 3 To 6282
If Trim(Cells(i, 1)) = Trim(Sheet5.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Sheet5.Cells(j, 1) = "ok"
Sheet5.Cells(j, 19) = Cells(i, 14)
Sheet5.Cells(j, 20) = Cells(i, 16)
Sheet5.Cells(j, 27) = Cells(i, 30)
Sheet5.Cells(j, 28) = Cells(i, 11)
Sheet5.Cells(j, 4) = Cells(i, 17)
Sheet5.Cells(j, 5) = Cells(i, 34)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 2140
For j = 3 To 2082
If Trim(Cells(i, 1)) = Trim(Sheet2.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Sheet2.Cells(j, 1) = "ok"
Sheet2.Cells(j, 19) = Cells(i, 13)
Sheet2.Cells(j, 20) = Cells(i, 15)
Sheet2.Cells(j, 27) = Cells(i, 29)
Sheet2.Cells(j, 28) = Cells(i, 10)
Sheet2.Cells(j, 4) = Cells(i, 16)
Sheet2.Cells(j, 5) = Cells(i, 33)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 2143
For j = 3 To 2890
If Trim(Cells(i, 1)) = Trim(Sheet4.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Sheet4.Cells(j, 1) = "ok"
Sheet4.Cells(j, 27) = Cells(i, 29)
Sheet4.Cells(j, 28) = Cells(i, 10)
Sheet4.Cells(j, 5) = Cells(i, 33)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 2292
For j = 3 To 8304
If Trim(Cells(i, 1)) = Trim(Sheet3.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Sheet3.Cells(j, 1) = "ok"
Sheet3.Cells(j, 27) = Cells(i, 29)
Sheet3.Cells(j, 28) = Cells(i, 11)
Sheet3.Cells(j, 5) = Cells(i, 32)
Sheet3.Cells(j, 19) = Cells(i, 14)
Sheet3.Cells(j, 20) = Cells(i, 16)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 2082
For j = 2 To 4157
If Trim(Cells(i, 2)) = Trim(Sheet1.Cells(j, 2)) Then
Cells(i, 1) = "ok"
Sheet1.Cells(j, 3) = Cells(i, 6)
Sheet1.Cells(j, 4) = "ok"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 2082
For j = 2 To 3255
If Trim(Cells(i, 2)) = Trim(Sheet2.Cells(j, 2)) Then
Cells(i, 1) = "ok"
Sheet2.Cells(j, 3) = Cells(i, 6)
Sheet2.Cells(j, 4) = "ok"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 3255
For j = 2 To 2082
If Trim(Cells(i, 2)) = Trim(Sheet1.Cells(j, 2)) Then
Cells(i, 1) = "ok"
Sheet1.Cells(j, 4) = Cells(i, 16)
Sheet1.Cells(j, 5) = Cells(i, 33)
Sheet1.Cells(j, 19) = Cells(i, 13)
Sheet1.Cells(j, 20) = Cells(i, 15)
Sheet1.Cells(j, 1) = "ok"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 3255
For j = 2 To 2082
If Trim(Cells(i, 2)) = Trim(Sheet1.Cells(j, 2)) Then
Cells(i, 1) = "ok"
Sheet1.Cells(j, 4) = Cells(i, 16)
Sheet1.Cells(j, 5) = Cells(i, 33)
Sheet1.Cells(j, 19) = Cells(i, 13)
Sheet1.Cells(j, 20) = Cells(i, 15)
Sheet1.Cells(j, 1) = "ok"
Sheet1.Cells(j, 27) = Cells(i, 29)
Sheet1.Cells(j, 28) = Cells(i, 10)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 4995
For j = 3 To 7696
If Trim(Cells(i, 2)) = Trim(Sheet1.Cells(j, 3)) Then
Cells(i, 1) = "ok"
Sheet1.Cells(j, 2) = "ok"
Cell
s(j, 4) = Sheet1.Cells(i, 17)
Cells(j, 5) = Sheet1.Cells(i, 34)
Cells(j, 19) = Sheet1.Cells(i, 14)
Cells(j, 20) = Sheet1.Cells(i, 16)
Cells(j, 27) = Sheet1.Cells(i, 30)
Cells(j, 28) = Sheet1.Cells(i, 11)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 6281
For j = 2 To 13591
If Trim(Cells(i, 2)) = Trim(Sheet2.Cells(j, 2)) Then
Cells(i, 1) = "ok"
Sheet2.Cells(j, 1) = "ok"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 5911
For j = 2 To 169
If Trim(Cells(i, 2)) = Trim(Sheet8.Cells(j, 1)) Then
Cells(i, 4) = "ok"
Sheet8.Cells(j, 3) = "ok"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 32
For j = 3 To 169
If Trim(Cells(i, 4)) = Trim(Sheet8.Cells(j, 1)) Then
Cells(i, 3) = "ok"
Cells(i, 2) = Sheet8.Cells(j, 31)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 5912
For j = 2 To 5913
If Trim(Cells(i, 3)) = Trim(Sheet8.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Cells(i, 1) = Sheet8.Cells(j, 28)
Sheet8.Cells(j, 1) = "ok"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 5913
For j = 3 To 5913
If Trim(Cells(i, 3)) = Trim(Sheet12.Cells(j, 2)) Then
Cells(i, 2) = "ok"
Cells(i, 5) = Sheet12.Cells(j, 16)
Cells(i, 6) = Sheet12.Cells(j, 33)
Cells(i, 20) = Sheet12.Cells(j, 13)
Cells(i, 21) = Sheet12.Cells(j, 15)
Cells(i, 28) = Sheet12.Cells(j, 29)
Cells(i, 29) = Sheet12.Cells(j, 10)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 371
For j = 3 To 1367
If Trim(Cells(i, 10)) = Trim(Sheet7.Cells(j, 11)) Then
Cells(i, 2) = Sheet7.Cells(j, 2)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim
i, j As Integer
For i = 2 To 174
For j = 2 To 162
If Trim(Cells(i, 2)) = Trim(Sheet7.Cells(j, 2)) Then
Cells(i, 1) = "ok"
Cells(i, 4) = Sheet7.Cells(j, 16)
Cells(i, 5) = Sheet7.Cells(j, 33)
Cells(i, 19) = Sheet7.Cells(j, 13)
Cells(i, 20) = Sheet7.Cells(j, 15)
Cells(i, 27) = Sheet7.Cells(j, 29)
Cells(i, 28) = Sheet7.Cells(j, 10)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 2081
For j = 2 To 2098
If Trim(Cells(i, 3)) = Trim(Sheet7.Cells(j, 3)) Then
Sheet7.Cells(j, 2) = Cells(i, 2)
Cells(i, 1) = "ok"
Sheet7.Cells(j, 1) = "ok"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 6465
For j = 5 To 8383
If Trim(Cells(i, 32)) = Trim(Sheet8.Cells(j, 8)) Then
Cells(i, 1) = "资源ok"
Cells(i, 3) = Sheet8.Cells(j, 2)
Sheet8.Cells(j, 1) = "财务ok"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 165
For j = 3 To 3344
If Trim(Cells(i, 2)) = Trim(Sheet2.Cells(j, 4)) Then
Cells(i, 1) = "ok"
Sheet2.Cells(j, 5) = "ok"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 2430
For j = 2 To 3831
If Trim(Cells(i, 6)) = Trim(Sheet9.Cells(j, 33)) Then
Cells(i, 1) = "财务完全对应"
Sheet9.Cells(j, 1) = "资源完全对应"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 5918
For j = 2 To 5918
If Trim(Cells(i, 4)) = Trim(Sheet4.Cells(j, 3)) Then
Cells(i, 1) = "卡片完全对应"
Sheet4.Cells(j, 1) = "卡片完全对应"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 3 To 2051
For j = 2 To 5918
If Trim(Cells(i, 3)) = Trim(Sheet4.Cells(j, 5)) Then
Cells(i, 1) = Sheet4.Cells(j, 32)
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 5912
For j = 2 To 4565
If Trim(Cells(i, 6)) = Trim(Sheet8.Cells(j, 33)) Then
Cells(i, 1) = "财务完全对应"
Sheet8.Cells(j, 1) = "资源完全对应"
Exit For
End If
Next
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, j As Integer
For i = 2 To 2202
For j = 2 To 3587
If Trim(Cells(i, 3)) = Trim(Sheet9.Cells(j, 2)) Then
Cells(i, 1) = "财务完全对应"
Sheet9.Cells(j, 1) = "资源完全对应"
Sheet9.Cells(j, 34) = Cells(i, 6)
Exit For
End If
Next
Next
End Sub