Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 10000, 1 To 3), i&, j%, R&, T$
Brr = Range([I2], Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
T = Brr(i, 1)
For j = 2 To UBound(Brr, 2)
If Val(Brr(i, j)) <> 0 Then
R = R + 1
Crr(R, 1) = T
Crr(R, 2) = Brr(1, j)
Crr(R, 3) = Val(Brr(i, j))
End If
Next
Next
Intersect(ActiveSheet.UsedRange.Offset(2, 11), [L:N]).ClearContents
If R = 0 Then Exit Sub
[L3:N3].Resize(R) = Crr
End Sub作者: hcm19522 時間: 2024-10-18 13:34