|
|
Sub 整理()
Dim ar As Variant
Dim br()
Dim i As Long
With Sheets("原数据")
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a1:ah" & r)
End With
ReDim br(1 To UBound(ar) * UBound(ar, 2), 1 To 7)
For i = 4 To UBound(ar) Step 4
If Trim(ar(i, 1)) <> "" Then
For j = 4 To UBound(ar, 2)
If Trim(ar(2, j)) <> "" Then
n = n + 1
br(n, 1) = ar(i, 1)
br(n, 2) = ar(i, 2)
br(n, 3) = ar(2, j)
br(n, 4) = ar(i, j)
br(n, 5) = ar(i + 1, j)
br(n, 6) = ar(i + 2, j)
br(n, 7) = ar(i + 3, j)
End If
Next j
End If
Next i
With Sheets("希望得到的结果")
rs = .Cells(Rows.Count, 1).End(xlUp).Row + 3
.Range("a3:g" & rs) = Empty
.[a3].Resize(n, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub |
|
