hiko-blog

VBA業務改善

MENU

エクセル 縦 の データ を 横 に(同一項目縦から横列へ)

必要に迫られて。。。

 

 <コード>


Sub 同一項目縦から横列へ()
Dim i1, i2 As Range
Dim oj1, oj2 As String

'コードスタート位置
Set i1 = Range("A1")

'展開位置
Set i2 = Range("g1")

'同一項目縦から横列へ
Do Until i1.Value = ""
If oj1 = "" Then
oj1 = i1.Value
oj2 = i1.Offset(, 1).Value
ElseIf i1.Value = oj1 Then
oj2 = oj2 & "、" & i1.Offset(, 1).Value
Else
i2.Value = oj1
i2.Offset(, 1).Value = oj2
Set i2 = i2.Offset(1)

oj1 = i1.Value
oj2 = i1.Offset(, 1).Value
End If
Set i1 = i1.Offset(1)
Loop

If oj1 <> "" Then
i2.Value = oj1
i2.Offset(, 1).Value = oj2
End If

End Sub