excel vbaで次のようなコードを作りたいです。
シート1に元データが4000件ほどあります。
シート2に、シート1のidが同じものを、3行ずつ横に表示したいです。
idと名前は1度のみ、それ以降は都道府県名と数字のみ表示します。
同じidを持つものが3行に満たないのであれば、改行します。
同じidを持つものが3行以上ある場合は、3行ごとに改行します。
1 佐藤 東京 1000
1 佐藤 千葉 2100
1 佐藤 青森 1300
2 鈴木 東京 5600
2 鈴木 千葉 3500
3 山田 三重 2910
3 山田 長野 3820
3 山田 山口 8760
3 山田 沖縄 6560
4
:
↓
1 佐藤 東京 1000 千葉 2100 青森 1300
2 鈴木 東京 5600 千葉 3500
3 山田 三重 2910 長野 3820 山口 8760
3 山田 沖縄 6560
4
:
どなたかこのような動作を行うvbaのコードを教えてください。
よろしくお願いします。
No.1ベストアンサー
- 回答日時:
(1)Alt+F11でVBEを開き、挿入→標準モジュール
(2)作成された標準モジュールへ以下のVBAコードを貼付
(3)コード内の以下の箇所を該当のシート名に合わせて修正
'対象のシートを設定
Set mySt(0) = Worksheets("Sheet1") ←元データのシート
Set mySt(1) = Worksheets("Sheet2") ←表示先のシート
(4)Alt+F11でVBEを閉じ、Alt+F8で「sample」マクロを実行
※補足
処理中で使用している区切り文字列について
元データのA列(ID)に「;」「,」を含む場合は正常に動作しません。
含む可能性がある場合は、コード内の以下の箇所をそれぞれ元データで使用していない
文字列に変更してください。(key(0)とkey(1)は別の文字列としてください)
key(0) = ";": key(1) = ","
■VBAコード
Sub sample()
'変数を宣言
Dim mySt(1) As Worksheet, key(1) As String
Dim bsData() As Variant, myData() As Variant
Dim i As Long, j As Long, cnt As Long
Dim names() As String, buf As Variant
Dim tar As Range, flag As Boolean
'対象のシートを設定
Set mySt(0) = Worksheets("Sheet1")
Set mySt(1) = Worksheets("Sheet2")
'区切り文字(必要であれば変更)
key(0) = ";": key(1) = ","
'配列にデータを格納
With mySt(0)
bsData = .Range(.Cells(1, "A"), .Cells(Rows.Count, "C").End(xlUp))
End With
'重複しない名前の配列を作成
For i = 1 To UBound(bsData, 1)
flag = True
If Sgn(names) <> 0 Then
For j = 0 To UBound(names, 2)
If names(0, j) = bsData(i, 1) Then
flag = False
Exit For
End If
Next j
End If
If flag Then
If Sgn(names) = 0 Then
ReDim names(1, 1)
Else
ReDim Preserve names(1, UBound(names, 2) + 1)
End If
names(0, UBound(names, 2)) = bsData(i, 1)
End If
Next i
'名前配列へ同名のデータを集約
For i = 1 To UBound(names, 2)
For j = 1 To UBound(bsData, 1)
If bsData(j, 1) = names(0, i) Then
names(1, i) = names(1, i) & bsData(j, 2) & key(1) & bsData(j, 3) & key(0)
End If
Next j
Next i
'シートへ書き出し
Application.ScreenUpdating = False
With mySt(1)
.Cells.ClearContents
For i = 1 To UBound(names, 2)
buf = Split(names(1, i), key(0))
For j = 0 To UBound(buf) - 1
If j Mod 3 = 0 Then
cnt = cnt + 1
Set tar = .Cells(cnt, "A")
tar = names(0, i)
End If
tar.Offset(0, (j Mod 3) * 2 + 1) = Left(buf(j), InStr(1, buf(j), key(1)) - 1)
tar.Offset(0, (j Mod 3) * 2 + 2) = Right(buf(j), Len(buf(j)) - InStr(1, buf(j), key(1)))
Next j
Next i
End With
Application.ScreenUpdating = True
'終了
MsgBox "終了"
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- Oracle sqlで質問です。 idを元にidに紐付くデータで住所コードがjpのみのデータ以外のidを取得したい 4 2023/03/20 17:41
- 野球 世界一ですか 4 2022/11/11 06:17
- 野球 世界一ですか 2 2022/11/11 06:15
- 野球 日本代表 これで世界一ですか 2 2022/11/11 05:59
- Excel(エクセル) EXCEL 関数を教えてください。(A列の同じ値が複数ある場合vlookupで出来ますか) 4 2022/12/07 20:54
- Excel(エクセル) Excelマクロの差分抽出のコードを教えていただきたいです。 2 2023/03/14 11:40
- MySQL 【MySQL】本当に困っているので、助けてください。よろしくお願いします。 3 2023/06/03 14:24
- Excel(エクセル) エクセルの条件付き書式 個人シートを参照して集計シートに色付けしたい 1 2023/06/22 00:39
- 転職 長く続けられる好条件の求人でしょうか? 3 2023/07/12 18:45
このQ&Aを見た人はこんなQ&Aも見ています
-
「どうして捨てられないの?」前妻の物を捨てられない男性の心理って?
前妻の物を捨てられない理由に加え、捨てるための手段はあるのかを専門家に聞いてみた!
-
重複するIDのデータを1行にまとめるvbaのコード
Access(アクセス)
-
VBAで重複データを合算したい
Excel(エクセル)
-
VBAで重複する項目を1つにまとめて金額を合計したい
Excel(エクセル)
-
-
4
EXCELのVBAで、重複データを隣のセルへ移動したい
Access(アクセス)
-
5
EXCELで2列を参照し、重複するものを横に並べたい
Excel(エクセル)
-
6
VBAで重複するデータがあれば1個だけ残して他の重複セルを"(空白)にしたいのですが
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
別のシートから値を取得するとき
-
excelのマクロで該当処理できな...
-
XL:BeforeDoubleClickが動かない
-
同じ作業を複数のシートに実行...
-
特定の文字を含むシートだけマ...
-
エクセルのシート名変更で重複...
-
【ExcelVBA】全シートのセルの...
-
実行時エラー'1004': WorkSheet...
-
ExcelのVBAのマクロで他のシー...
-
エクセルのマクロでアクティブ...
-
VBA 存在しないシートを選...
-
ブック名、シート名を他のモジ...
-
Excelマクロのエラーを解決した...
-
実行時エラー1004「Select メソ...
-
VBA 入力月で該当シートを選択...
-
【VBA】シート名に特定文字が入...
-
userFormに貼り付けたLabelを変...
-
エクセル Worksheet_Calculate
-
ListViewの画面の更新
-
Excel VBA 複数行を数の分だけ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
別のシートから値を取得するとき
-
excelのマクロで該当処理できな...
-
【ExcelVBA】全シートのセルの...
-
ユーザーフォームに入力したデ...
-
同じ作業を複数のシートに実行...
-
ブック名、シート名を他のモジ...
-
特定の文字を含むシートだけマ...
-
実行時エラー'1004': WorkSheet...
-
VBA 存在しないシートを選...
-
エクセルのシート名変更で重複...
-
XL:BeforeDoubleClickが動かない
-
シートが保護されている状態で...
-
Excel VBA 複数行を数の分だけ...
-
実行時エラー1004「Select メソ...
-
【Excel VBA】Worksheets().Act...
-
Excelマクロのエラーを解決した...
-
エクセル・マクロ シートの非...
-
VBAで同じシート名のコピー時は...
-
ExcelのVBAのマクロで他のシー...
-
【VBA】色のついたシート名を取得
おすすめ情報