教えて!gooにおける不適切な投稿への対応について

Excel VBA 複数のセルをひとつのセルに転記する方法を教えて下さい

2つの表があります

【表1】(縦の表)
A1:G(最終行は変動)
1行目は項目行
A2以下が名前
G列が支店名

【表2】(横の表)
J1:(最終列は変動)5
1行目に表1A2以下の重複しない名前を関数で表示させています。

この名前の下(J2:(最終列は変動)2)に、その名前に対する表1G列の支店名を
転記させたいと思います。

この際に複数のセルがあってもまとめてひとつのセルに入力を希望します。

★例★
J1が石川の場合
A2 石川 G2 東京支店、横浜支店
A4 石川 G4 神戸支店、京都支店
J2に東京支店、横浜支店、神戸支店、京都支店 と転記

K1が鈴木の場合
A3 鈴木 G3 千葉支店、群馬支店
A5 鈴木 G5 大阪支店、兵庫支店
A6 鈴木 G5 札幌支店、函館支店
K2に千葉支店、群馬支店、大阪支店、兵庫支店、札幌支店、函館支店 と転記

こちら実行できるコードをご存知でしたら、是非教えて頂きたいです。
どうぞ宜しくお願い致します。

gooドクター

A 回答 (3件)

以下のマクロを標準モジュールに登録してください。



Option Explicit

Public Sub 支店名設定()
Const delm As String = "、"
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim dicT As Object
Dim maxrow As Long
Dim maxcol As Long
Dim wrow As Long
Dim wcol As Long
Dim branch As Variant
Dim bname As String
Dim name As String
Dim i As Long
Dim j As Long
Dim aryList As Object
Dim flg As Boolean
Set dicT = CreateObject("Scripting.Dictionary")
Set sh1 = worksheets("Sheet1")
maxrow = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'A列最終行を求める
maxcol = sh1.Cells(1, Columns.Count).End(xlToLeft).Column '1行目の最終列を求める
For wrow = 2 To maxrow
If sh1.Cells(wrow, "A").Value <> "" And sh1.Cells(wrow, "G").Value <> "" Then
name = sh1.Cells(wrow, "A").Value
branch = Split(sh1.Cells(wrow, "G").Value, delm)
If dicT.exists(name) = False Then
Set aryList = CreateObject("System.Collections.ArrayList")
dicT.Add name, aryList
Else
Set aryList = dicT(name)
End If
For i = 0 To UBound(branch)
bname = branch(i)
flg = False
For j = 0 To aryList.Count - 1
If bname = aryList.Item(j) Then flg = True
Next
If flg = False Then
dicT(name).Add bname
End If
Next
End If
Next
For wcol = 10 To maxcol
name = sh1.Cells(1, wcol).Value
If name <> "" And dicT.exists(name) = True Then
Set aryList = dicT(name)
branch = aryList.toarray
sh1.Cells(2, wcol).Value = Join(branch, delm)
End If
Next
End Sub
    • good
    • 0
この回答へのお礼

どうもありがとうございまた。

お礼が遅くなってしまい申し訳ありません。
とても丁寧に教えて下さって助かりました(´∀`)

お礼日時:2021/04/20 23:09

>支店が被ることはあります。


>もし被ったら支店と区切りの「、」を削除したいです。
そうなると、一旦、「、」で支店をばらして、重複をなくしたのち、再度組み立てる必要があります。
その場合の区切り文字は「、」で間違いないでしょうか。(全角です)
(他の区切値文字が混じっていたりすると正しく処理できなくなります。例えば半角のカンマ「,」等があっても、それは区切り文字とは解釈されないので「東京支店,大阪支店」は、"東京支店,大阪支店"という1つの支店とみなされます)

表1のシート名は"Sheet1"でよろしいでしょうか。
表2のシート名は"Sheet2"でよろしいでしょうか。
上記と異なる場合は、シート名をご提示ください。
    • good
    • 0
この回答へのお礼

ありがとうございます!
区切りは必ず「、」です。
表1と表2は同じシートにあり、両方ともSheet1でお願い致します。

お礼日時:2021/04/19 12:11

1.表1のG列の1つのセルに必ず、2つの支店が格納されているのですか。


2.又、以下のように支店が被ることはないのですか。
A2 石川 G2 東京支店、横浜支店
A4 石川 G4 東京支店、京都支店
その場合、J2に「東京支店、横浜支店、東京支店、京都支店」となっても良いですか。
    • good
    • 0
この回答へのお礼

ありがとうございます!
1.G列のひとつのセルには0の場合もありますし、ひとつ以上(複数)の場合もあります。

2.支店が被ることはあります。
もし被ったら支店と区切りの「、」を削除したいです。重複の削除は可能でしょうか?難しければご提示頂いた感じでも大丈夫です。

お礼日時:2021/04/19 11:22

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング