- Sub 取数()
- Range("C2:I1000") = Empty
- Dim brr(), arr, i, j, s, m, sht
- For Each sht In Sheets
- If InStr(sht.Name, "表四") Then
- arr = sht.UsedRange
- For i = 8 To UBound(arr)
- If arr(i, 5) > 0 Then
- m = m + 1
- ReDim Preserve brr(1 To 5, 1 To m)
- brr(1, m) = sht.Name
- brr(2, m) = arr(i, 2)
- brr(3, m) = arr(i, 3)
- brr(4, m) = arr(i, 5)
- End If
- Next
- End If
- Next
- For i = 1 To m
- For j = 3 To 5
- If Cells(1, j) = brr(1, i) Then brr(5, i) = j
- Next
- Next
- s = Sheet5.[A65536].End(3).Row
- For i = 2 To s
- For j = 1 To m
- If Cells(i, 1) = brr(2, j) And Cells(i, 2) = brr(3, j) Then
- Cells(i, brr(5, j)) = brr(4, j)
- End If
- Next
- Next
- End Sub
复制代码 |