|
Sub db()
Dim brr()
arr = Sheets("生产记录").Range("b5:r" & [c65536].End(3).Row)
s = [c3]
If s = "" Then
Range("b6:q" & [b65536].End(3).Row).ClearContents
Exit Sub
End If
For i = 1 To UBound(arr)
For j = 2 To 6
If InStr(arr(i, j), s) >= 1 Then
n = n + 1
ReDim Preserve brr(1 To 16, 1 To n)
For k = 1 To 16
brr(k, n) = arr(i, k)
Next
Exit For
End If
Next
Next
Range("b6:q" & [b65536].End(3).Row).ClearContents
If n <> "" Then
[b6].Resize(n, 16) = Application.Transpose(brr)
Else
Exit Sub
End If
Dim brr1()
arr1 = Sheets("sheet3").Range("a2:f1000")
If s = "" Then
Range("x6:ad1000").ClearContents
Exit Sub
End If
For i1 = 1 To UBound(arr1)
For j1 = 2 To 6
If InStr(arr1(i1, j1), s) >= 1 Then
n1 = n1 + 1
ReDim Preserve brr1(1 To 6, 1 To n1)
For k1 = 1 To 6
brr1(k1, n1) = arr1(i1, k1)
Next
Exit For
End If
Next
Next
Range("x6:ad1000").ClearContents
If n1 <> "" Then
[x6].Resize(n1, 6) = Application.Transpose(brr1)
End If
End Sub |
评分
-
1
查看全部评分
-
|