|
Sub 转置()
Sheets("需要的结果").Range("i4:z5").ClearContents
brr = Sheets(3).Range("d2:e" & Sheets("数据库").Range("e65536").End(xlUp).Row)
arr = Sheets(3).Range("a2:c" & Sheets("数据库").Range("a65536").End(xlUp).Row)
ReDim crr(1 To UBound(arr), 1 To 2)
For o = 1 To UBound(brr)
If Sheets("需要的结果").Range("g3") = brr(o, 1) Then m = brr(o, 2)
Next
For i = 1 To UBound(arr)
ar = Split(arr(i, 3), " ")
If Left(ar(0), 4) * 1 = m * 1 Then
k = k + 1
crr(k, 2) = arr(i, 1) - arr(i, 2)
crr(k, 1) = ar(1)
End If
Next
Sheets("需要的结果").Range("i4").Resize(2, k) = Application.Transpose(crr)
End Sub
简单弄弄 |
|