|
|
楼主 |
发表于 2018-8-21 16:39
|
显示全部楼层
自己多次试错、再调整成功！以下是我修改后的VBA
Sub justtest()
Dim ar1, ar2, i&, j&, k&, s$
Application.ScreenUpdating = False
ar1 = Range("f1:f" & Cells(Rows.Count, 6).End(3).Row).Value 'a2可修改，为表头,(Rows.Count, 2)中2为列数
ar2 = Range("g1:g" & Cells(Rows.Count, 7).End(3).Row).Value 'd2可修改，为表头
Range("f:f", "g:g").Interior.Color = xlNone
Range("h1").Interior.Color = vbGreen '("f2")
For i = 3 To UBound(ar1, 1) '3
If ar1(i, 1) <> 0 Then
For j = 2 To UBound(ar2, 1)
If ar2(j, 1) = ar1(i, 1) Then
ar2(j, 1) = 0
t = True
GoTo 100
End If
Next j
For j = 3 To UBound(ar2, 1) - 1 '3
For k = j + 1 To UBound(ar2, 1)
If ar2(j, 1) + ar2(k, 1) = ar1(i, 1) Then
ar2(j, 1) = 0
ar2(k, 1) = 0
GoTo 100
End If
Next k, j
s = s & ",f" & i '",f"
If Len(s) > 245 Then Range(Mid(s, 2)).Interior.Color = vbGreen: s = ""
End If
100
Next i
If Len(s) > 0 Then Range(Mid(s, 2)).Interior.Color = vbGreen: s = ""
For i = 3 To UBound(ar2, 1) '3
If ar2(i, 1) > 0 Then s = s & ",g" & i '",g"
If Len(s) > 245 Then Range(Mid(s, 2)).Interior.Color = vbGreen: s = ""
Next
If Len(s) > 0 Then Range(Mid(s, 2)).Interior.Color = vbGreen: s = ""
Application.ScreenUpdating = True
End Sub |
|
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-8-20 09:22
