vba：二つの表から新しい表を作る

質問

お世話になっております。

分かりづらいですが、イメージとしてはこのような感じの表を作りたいのです
（数の計算列、セルの色塗りは不要です）
http://fast-uploader.com/file/6972978179745/

表１、表２の行数は可変です。（空欄の場合もあります）
表２の所属コードは必ず表１にもあります。

自分の知識では考えても形にならず、どうか知恵をお借りできないでしょうか

回答No.4

tom04 · ベストアンサー

こんばんは！

やはりVBAでやってみました。
すでに的確な回答が出ていますので、参考程度で・・・

＞（空欄の場合もあります）
が少し引っかかりますので、途中に空白セルがあっても対応できるようにしています。

↓の画像のようにSheet1が「表1」・Sheet2が「表2」として、Sheet3に表示するようにしてみました。
標準モジュールにコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim i As Long, k As Long, lastRow As Long
Dim c As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Worksheets("Sheet3")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow, "C")).ClearContents
End If
For i = 2 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
If wS1.Cells(i, "B") <> "" Then
Set c = wS2.Range("A:A").Find(what:=wS1.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
k = c.Row
Do While wS2.Cells(k, "A") <> "" And wS2.Cells(k, "A") = c
With .Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Value = c
.Offset(, 1) = wS2.Cells(k, "B")
.Offset(, 2) = wS1.Cells(i, "C") * wS2.Cells(k, "C")
End With
k = k + 1
Loop
End If
End If
Next i
Application.ScreenUpdating = True
.Activate
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

回答、ありがとうございます
思い描いていた通りの処理をしてくれました。

空欄の場合にも対応してくださり、ありがとうございます。

回答No.3

WindFaller

こんばんは。

イメージとしてはこんな感じかな（^^;
>（空欄の場合もあります）
ここが分かりませんが、後は考えてください。
それから、VBAで解決するのが良いのか、関数で解決するのかも、私には見当が付きません。

'//
Sub Test1()
Dim c As Variant
Dim r As Variant
Dim i As Long
i = 4 '最初の行数
For Each c In Range("A4", Cells(Rows.Count, 1).End(xlUp))
If IsNumeric(c.Offset(, 1).Value) Then
　For Each r In Range("E4", Cells(Rows.Count, 5).End(xlUp))
　 If c.Offset(, 1).Value = r.Value Then
　　 Cells(i, 9).Value = r.Value
　　 Cells(i, 10).Value = r.Offset(, 1).Value
　　 Cells(i, 11).Value = r.Offset(, 2).Value * c.Offset(, 2).Value
　　 i = i + 1
　 End If
　Next r
End If
Next c
End Sub

'//

お礼

回答、ありがとうございます。

このような簡潔なコードで解決できるのですね
あてはめてみるとエラーがでてしまいましたが
いい機会ですのでこのコードを使っても動作できるよう考えてみます

回答No.2

FEX2053

ごめん、追記です。

誤：区分できる何等かの項目を・・・
正：区分できる何等かの項目を表１，２の両方に・・・

回答No.1

FEX2053

データ（項目）が足りないのでどうやってもできませんよ。

表１と表２を結びつけるのは「所属コード」しかないんですが、
これがユニーク（単一）ではないですから。「所属コード」が
「10000」と言った場合、「リンゴ１」「リンゴ２」「リンゴ３」の
どれかが分かりませんもん。

ですので、「リンゴ１」「リンゴ２」「リンゴ３」を区分できる何等か
の項目を追加しないといけません。

追加が出来れば、あとは=Vlookup関数だけの話です。

お礼

回答、ありがとうございます。
説明を省いてしまって申し訳ありません
りんご１～３がどれなのかは実は必要ないのです。
もう少し情報があれば関数だけでも可能なのですね。