excel吧 关注：280,857贴子：1,543,482
- 14回复贴，共1页
菠萝蜜
Option Explicit
Sub abc()
Dim a, b, i, j, m
a = [a1].CurrentRegion.Resize(, 1).Value
b = Range("b1:b" & [b1].End(xlDown).Row).Value
For i = 1 To UBound(a) - UBound(b) + 1
If a(i, 1) = b(1, 1) Then
For j = i To i + UBound(b) - 1
If a(j, 1) <> b(j - i + 1, 1) Then Exit For
Next
If j = i + UBound(b) Then
If j - 1 < UBound(a) Then
m = m + 1
a(m, 1) = a(j, 1)
End If
End If
End If
Next
With [d:d]
.ClearContents
If m > 0 Then .Resize(m) = a
End With
End Sub
Option Explicit
Sub abc()
Dim a, b, i, j, k, t, d(1)
Application.ScreenUpdating = False
a = [a1].CurrentRegion.Resize(, 5).Value
b = [g1].Resize(UBound(a), 21).Value
ReDim c(1 To UBound(a), 1 To 1)
For i = 0 To UBound(d)
Set d(i) = CreateObject("scripting.dictionary")
Next
For i = 1 To UBound(a)
For j = 1 To UBound(a, 2)
d(0)(a(i, j)) = d(0)(a(i, j)) & "," & j
Next
For j = 1 To UBound(b, 2)
If d(0).exists(b(i, j)) Then
Cells(i, j + 5 + 1).Interior.Color = vbGreen
t = Split(d(0)(b(i, j)), ",")
For k = 1 To UBound(t)
Cells(i, Val(t(k))).Interior.Color = vbGreen
Next
d(1)(b(i, j)) = 1
End If
Next
c(i, 1) = d(1).Count
For j = 0 To UBound(d)
d(j).RemoveAll
Next
Next
[ac1].Resize(UBound(c)) = c
Application.ScreenUpdating = True
End Sub
