| |
▼すず さん：
上でご提案した方式の場合のコード案です。
Sub Sample()
Dim c As Range, myA As Range
Dim x As Long
Dim v As Variant
Dim s As String
Application.ScreenUpdating = False
With Sheets("Sheet1")
With .UsedRange
Set myA = Intersect(.Cells, .Offset(1))
If Not myA Is Nothing Then myA.ClearContents
End With
Set myA = .Range("A2")
End With
With Sheets("Sheet2")
.Cells.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes
For Each c In .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
x = .Cells(c.Row, .Columns.Count).End(xlToLeft).Column
v = c.Offset(, 1).Resize(, x - 1).Value
If IsArray(v) Then
v = WorksheetFunction.Index(v, 1, 0)
s = Join(v, ",")
Else
s = v
End If
myA.Value = c.Value
myA.Offset(, 1).Value = s
Set myA = myA.Offset(1)
Next
End With
Set myA = Nothing
Application.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
