|
▼たろう さん:
こんにちは
以下のようなことですか?
Sub Sample()
Dim lMax As Long
Dim v() As String
Dim c As Range
Dim k As Long
Dim oLvl As Long
With Sheets("Sheet1") '元シート
With .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
lMax = WorksheetFunction.Max(.Columns(1))
ReDim v(1 To .Rows.Count, 1 To lMax)
For Each c In .Columns(1).Cells
If c.Value = 1 Or c.Value <= oLvl Then k = k + 1
v(k, c.Value) = c.Offset(, 1).Value
oLvl = c.Value
Next
End With
End With
With Sheets("Sheet2") '転記シート
.UsedRange.ClearContents
.Range("A1").Resize(k, UBound(v, 2)).Value = v
.Select
End With
MsgBox "転記完了です"
End Sub
|
|