２つのセルの組み合わせ

質問

図のようなコードをもとに、セルの文字を連結させて商品管理番号をつくりたいと考えています。

（11A1、11A2・・・、12A1、12A2、・・・14A6）
サンプルで出してありますが、このほかにもいくつかあります。

手動では大変なため、vbaにて処理をしたいと考えておりますが、
組み合わせなのか順列なのか、今ひとつ見当がつかず、どのようにvbaを記述すれば
スッキリするのか悩んでおります。

for nextでの処理で変数を用いれば可能なのでしょうが・・・
変数が1つなのか、2つなのか、どうもスッキリしません。

記述について、アドバイスいただければと思います。
不備がありましたらご指摘ください。よろしくお願いします。

回答No.1

tom04 · ベストアンサー

こんにちは！
一例です。

「地域コード」はB1セルから列方向に
「商品コード」はB2セルから列方向に
（A列は項目列で、データはB列以降にある）
あるとします。

Sheet2のA列に表示するようにしてみました。

画面左下のSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub test()
Dim j As Long
Dim k As Long
Dim cnt As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2")
ws.Columns(1).ClearContents
For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
For k = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
cnt = cnt + 1
ws.Cells(cnt, 1) = Cells(1, j) & Cells(2, k)
Next k
Next j
End Sub

こんな感じではどうでしょうか？m（_ _）m

お礼

回答ありがとうございました。
すっきりとした内容で、応用がききました。

回答No.4

MarcoRossiItaly

No.3 です。後出しされた条件にお答えします。

＞サンプルは2つの組み合わせですが、コードの組み合わせが3つになることもあり、提示のものでは難しいかなと。

簡単です。

No.3 の方法により 2 次元で作製された文字列の一覧を、ドラッグ・アンド・ドロップでも数式でも、好きな方法で 1 列に並べ替え、A 列に配置します（この際、数式を除去しないまま行うこともできます。）。さらに、第 3 の文字列をどこかの 1 行に入力し、また No.3 と同じことを繰り返すだけです。

このとき、第 3 の文字列が存在しない箇所については、そのセルを未入力のままにしておいて構いません。No.3 の数式は未入力のセルを参照しても問題がないので、文字列結合の数式の入力されているセルは特にそこだけ修正したりせず、単にコピペで大丈夫です。参照先が未入力なら、第 3 の文字列が付加されないだけのことです。

以上のことを手作業で行っても、一からマクロのコードを書くのに比べれば、恐らくより早く全てが完成します。

回答No.3

MarcoRossiItaly

マクロを持ち出すまでもないというか。数式で作るなら、このような。

1. A2:A5 のセル範囲に 11、12、13、14 と、B1:G1 に A1、…、A6 と入力。
2. B2 セルに次式を入力。

B2　=$A2&B$1

3. B2 セルをコピーし、B2:G5 に貼り付け。

お礼

回答ありがとうございました。
サンプルは2つの組み合わせですが、コードの組み合わせが3つになることもあり、提示のものでは難しいかなと。

回答No.2

K Kazz（@JazzCorp）

'データシートで実行（＝アクティブシート）
'空いているセルなら出力シート＝データシートでも構わない
'空白セルはスキップ

Sub OneWithTwo()
Const xName = "Sheet2" '出力シート
Const xBase_To = "A2" '出力の基点
Const xBase_From = "B1" 'データの基点
Dim xNum As Long
Dim xNum2 As Long
Dim jj As Long
Dim kk As Long
Dim mm As Long
Dim mm2 As Long
Dim nn As Long
Dim xSheet As Worksheet

Set xSheet = Worksheets(xName)
xSheet.Columns(1).Clear
With ActiveSheet
nn = 0
mm = Range(xBase_From).Row
mm2 = Range(xBase_From).Column
xNum=Cells(mm, Columns.Count).End(xlToLeft).Column-mm2+1
For jj = 0 To xNum
If (Range(xBase_From).Offset(, jj) <> Empty) Then
xNum2=Cells(mm + 1, Columns.Count).End(xlToLeft).Column-mm2+1
For kk = 0 To xNum2
If (Range(xBase_From).Offset(1, kk) <> Empty) Then
xSheet.Range(xBase_To).Offset(nn) = Range(xBase_From).Offset(, jj) & Range(xBase_From).Offset(1, kk)
nn = nn + 1
End If
Next kk
End If
Next jj
End With
Worksheets(xName).Select
End Sub

お礼

回答ありがとうございました。
先の方がありましたので、ベストにはできなかったこと、ご了承ください。