人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

行列関係のエクセルVBA作成をお願いします。


あるエクセルシートがあり、

G11から下にお客様名、AE11から商品名が入っています。

その直前の10行目が見出しで、下に向かってずっとお客様名、商品名がはいっています。


マクロをかけると、もしG列内で同じ名前(値)があったときには、上の方の名前の行のAE列内に集中して商品名が入るようにしてほしいのです。


G,AE
11,お名前,商品名
12,佐藤一,りんご
13,鈴木二,みかん
14,田中四,お米
15,近藤五,スイカ
16,佐藤一,オレンジ
17,鈴木二,納豆
18,佐藤一,おくら


とあったとします。マクロをかけると、
G,AE
11,商品名,名前
12,佐藤一,りんご、オレンジ、おくら
13,鈴木二,みかん、納豆
14,田中四,お米
15,近藤五,スイカ
16,佐藤一,空白
17,鈴木二,空白
18,佐藤一,空白


となるようにしていただきたいのです。
同じ名前の一番上に商品名がすべて入る形です。商品名と商品名の間は、「、」(全角)で区切ります。

16,17,18にある空白というのはスペースも入らず、商品名を切り取って貼り付ける形の残りのイメージです。

AE列が下に検索していき、空白になった時にマクロ停止でお願いします。

よろしくお願いいたします。

●質問者: naranara19
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● ku__ra__ge
●150ポイント ベストアンサー

以下のマクロでご希望の操作ができると思います。
お客様名、商品名の位置を変更したい場合、START_NAME、START_SHOHINの内容を変更してください。

Sub ReSummary()
 Const START_NAME = "G11"
 Const START_SHOHIN = "AE11"

 Set nameDic = CreateObject("Scripting.Dictionary")
 
  ' 情報収集
 Set nameRange = Range(START_NAME)
 rowOffset = 0
 Do While Not nameRange.Value = ""
 Set shohinRange = Range(START_SHOHIN).Offset(rowOffset, 0)
 If nameDic.exists(nameRange.Value) = False Then
 Call nameDic.Add(nameRange.Value, shohinRange.Value)
 Else
 nameDic(nameRange.Value) = nameDic(nameRange.Value) & "、" & shohinRange.Value
 End If
 
 Set nameRange = nameRange.Offset(1, 0)
 rowOffset = rowOffset + 1
 Loop
 
  ' 書き換え
 Set nameRange = Range(START_NAME)
 rowOffset = 0
 Do While Not nameRange.Value = ""
 Set shohinRange = Range(START_SHOHIN).Offset(rowOffset, 0)
 If nameDic.exists(nameRange.Value) Then
 shohinRange.Value = nameDic(nameRange.Value)
 Call nameDic.Remove(nameRange.Value)
 Else
 shohinRange.Value = ""
 End If

 Set nameRange = nameRange.Offset(1, 0)
 rowOffset = rowOffset + 1
 Loop
 
 MsgBox "end"
 
End Sub

naranara19さんのコメント
大変すばやく、かつ完璧なご対応誠にありがとうございまいした。エラー0で完璧に動作いたしました。感謝します。これからもどうぞよろしくお願いいたします。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ