| |
▼kuwamio さん：
要件を取り違えていたらごめんなさい。
Sub Sample()
Dim v() As String
Dim c As range
Dim dic As Object
Dim i As Long, j As Long, k As Long
Dim wk As Variant
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1").range("A1").CurrentRegion
ReDim v(1 To .Rows.Count, 1 To .Rows.Count * 3) 'Max
For Each c In .Columns(1).Cells
If Not dic.exists(c.Value) Then
k = k + 1
dic(c.Value) = Array(k, 0)
End If
wk = dic(c.Value)
wk(1) = wk(1) + 1
dic(c.Value) = wk
i = wk(0)
j = (wk(1) - 1) * 3 + 1
v(i, j) = c.Value
v(i, j + 1) = c.Offset(, 1).Value
v(i, j + 2) = c.Offset(, 2).Value
Next
End With
With Sheets("Sheet2")
.Cells.ClearContents
.range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
.range("A1:C1").Copy .range("D1").Resize(, .range("A1").CurrentRegion.Columns.Count - 3)
End With
Set dic = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
