商品情報にスキップ
Excel VBA A列が同じ場合横並びにする
- 更 新 日 :
- 実装環境: Windows 11 , office 2019
- データ処理その他 / Excel
- 確認 - セキュリティリスクの解除方法
環境によって内容が異なる場合がございます。ご確認・検証の上ご利用ください。
目次
- A列が同じ場合B列を横並び
- １．【入力】シートに並べ替えたい内容を記入
- 2．【基本】シートのスタートボタンを押す
- 3．【結果】シートに 都道府県順に並び変わります
A列が同じ場合B列を横並び
A列のテキストが同じ場合 B列を横並びにするVBAです。
１．【入力】シートに並べ替えたい内容を記入
| 都道府県 | 歴代首相 |
| 山口 | 伊藤 博文 |
| 山口 | 安部 晋三 |
| 山口 | 佐藤 栄作 |
| 新潟 | 田中 角栄 |
| 高知 | 吉田 茂 |
2．【基本】シートのスタートボタンを押す
3．【結果】シートに 都道府県順に並び変わります
| 都道府県 | 歴代首相 | ||
| 山口 | 伊藤 博文 | 安部 晋三 | 佐藤 栄作 |
| 新潟 | 田中 角栄 | ||
| 高知 | 吉田 茂 |
' 縦から横に並べ替え VBAコード
Sub TransformData()
Dim inputSheet As Worksheet
Dim outputSheet As Worksheet
Dim lastRow As Long
Dim outputRow As Long
Dim outputCol As Long
Dim key As String
Dim dict As Object
Dim i As Long
' シートを設定
Set inputSheet = ThisWorkbook.Sheets("入力")
Set outputSheet = ThisWorkbook.Sheets("結果")
' 結果シートをクリア
outputSheet.Cells.Clear
' キーを保持するための辞書を作成
Set dict = CreateObject("Scripting.Dictionary")
' 入力シートの最終行を取得
lastRow = inputSheet.Cells(inputSheet.Rows.Count, "A").End(xlUp).Row
' 入力シートをループ
For i = 1 To lastRow
key = inputSheet.Cells(i, 1).Value
' キーが辞書に存在しない場合、追加
If Not dict.exists(key) Then
dict.Add key, dict.Count + 1
outputRow = dict(key)
outputSheet.Cells(outputRow, 1).Value = key
outputCol = 2
Else
outputRow = dict(key)
outputCol = outputSheet.Cells(outputRow, Columns.Count).End(xlToLeft).Column + 1
End If
' B列以降のデータを出力シートにコピー
Dim j As Long
For j = 2 To inputSheet.Cells(i, Columns.Count).End(xlToLeft).Column
outputSheet.Cells(outputRow, outputCol).Value = inputSheet.Cells(i, j).Value
outputCol = outputCol + 1
Next j
Next i
End Sub
