学习老师的代码。谢谢老师!
Sub cx()
Dim arr, n, brr, i, j, k, crr, drr
arr = Sheet1.Range("d7:AJ153")
brr = Sheet3.Range("d7:AJ69")
ReDim crr(1 To UBound(arr) + UBound(brr), 1 To UBound(arr, 2))
For i = 1 To UBound(crr)
If i <= UBound(arr) Then
For j = 1 To UBound(arr, 2)
crr(i, j) = arr(i, j)
Next
Else
For j = 1 To UBound(arr, 2)
crr(i, j) = brr(i - UBound(arr), j)
Next
End If
Next
ReDim drr(1 To 33, 1 To 1)
Dim ccxx
For i = 1 To UBound(crr)
ccxx = crr(i, 1) & crr(i, 2) & crr(i, 3) & crr(i, 4) & crr(i, 5)
If VBA.InStr(ccxx, Sheet8.Cells(2, 6).Value) Then
k = k + 1
ReDim Preserve drr(1 To 33, 1 To k)
For j = 1 To 33
drr(j, k) = crr(i, j)
Next
End If
Next
drr = Application.Transpose(drr)
Sheet8.Cells(4, 1).Resize(100000, 33).ClearContents
If k > 0 Then Sheet8.Cells(4, 1).Resize(k, 33) = drr
End Sub
|