Option Explicit
Sub TEST()
Dim Brr, Crr, i&, j%, N&
工作表2.UsedRange.Offset(11).ClearContents
Brr = Range([工作表1!IV11].End(xlToLeft)(2), [工作表1!D65536].End(3))
ReDim Crr(1 To 1000, 1 To 9)
For i = 1 To UBound(Brr)
For j = 23 To UBound(Brr, 2) Step 3
If Trim(Brr(i, j)) = "" Then GoTo i01 Else N = N + 1
Crr(N, 1) = Brr(i, j + 2): Crr(N, 2) = Brr(i, j): Crr(N, 9) = Brr(i, 1)
Crr(N, 7) = Val(Brr(i, j + 1)) * Val(Brr(i, 10))
Next
i01: Next
If N = 0 Then Exit Sub
With 工作表2.[A12].Resize(N, 9)
.Value = Crr
.Sort KEY1:=.Item(1), Order1:=1, Header:=2
Application.Goto .Cells
End With
End Sub