|
こんにちは
以前同様の質問に答えた時のコードがありましたのでよろしければどうぞ。^d^
条件
・元データはアクティブシートのA1から
(A列で並べ替えがされている。これがNGならボツですが。)
・出力先は新規シートを挿入してそこに
Sub 縦横並べ替え()
Dim myRange As Range
Dim Key As Variant
Dim myCell As Range
Dim myVal As Variant
Dim rngDest As Range
Set myRange = Range("A1").CurrentRegion
Set rngDest = Worksheets.Add.Range("A1")
Key = ""
For Each myCell In myRange.Columns(1).Cells
myVal = myCell.Offset(, 1).Value
If myCell.Value <> Key Then
Key = myCell.Value
Set rngDest = rngDest.Offset(1)
With rngDest
.Value = Key
.Offset(, 1).Value = myVal
End With
Else
With rngDest
.End(xlToRight).Offset(, 1).Value = myVal
End With
End If
Next
Set myRange = Nothing
Set myCell = Nothing
Set rngDest = Nothing
End Sub
|
|