|
Sub 筛选()
Dim arr1, arr2, arr3, arr(), ar()
Dim m, n, i, k, q, H, j As Long
arr1 = Sheets("A店").Range("a2:c" & Sheets("A店").Range("c" & Rows.Count).End(3).Row)
arr2 = Sheets("B店").Range("a2:c" & Sheets("B店").Range("c" & Rows.Count).End(3).Row)
arr3 = Sheets("C店").Range("a2:c" & Sheets("C店").Range("c" & Rows.Count).End(3).Row)
k = UBound(arr1) + UBound(arr2) + UBound(arr3)
ReDim arr(1 To k, 1 To 4)
For m = 1 To UBound(arr1)
arr(m, 1) = "A店"
arr(m, 2) = arr1(m, 1)
arr(m, 3) = arr1(m, 2)
arr(m, 4) = arr1(m, 3)
Next m
For n = 1 To UBound(arr2)
arr(m + n - 1, 1) = "B店"
arr(m + n - 1, 2) = arr2(n, 1)
arr(m + n - 1, 3) = arr2(n, 2)
arr(m + n - 1, 4) = arr2(n, 3)
Next n
For i = 1 To UBound(arr3)
arr(m + n + i - 2, 1) = "C店"
arr(m + n + i - 2, 2) = arr3(i, 1)
arr(m + n + i - 2, 3) = arr3(i, 2)
arr(m + n + i - 2, 4) = arr3(i, 3)
Next i
H = Application.CountIf(Sheets("A店").Range("B:B"), Range("b2")) + _
Application.CountIf(Sheets("B店").Range("B:B"), Range("b2")) + _
Application.CountIf(Sheets("C店").Range("B:B"), Range("b2"))
ReDim ar(1 To H, 1 To 4)
For q = 1 To UBound(arr)
If arr(q, 3) = Range("b2").Value Then
j = j + 1
ar(j, 1) = arr(q, 1)
ar(j, 2) = arr(q, 2)
ar(j, 3) = arr(q, 3)
ar(j, 4) = arr(q, 4)
End If
Next q
Range("a5:d" & Range("d" & Rows.Count).End(xlUp).Row).ClearContents
Range("A5").Resize(UBound(ar), 4) = ar
End Sub |
评分
-
查看全部评分
|