| |
▼涙 さん：
こんにちは。
>
>質問の内容が分かりにくくて申し訳ないです。
いえ、内容は入力データと出力データ例を記述して頂きましたから
わかったつもりですが・・・。
>試してみましたところ、DDDだけではなく
>リストにあった全てのデータが以下のように
私の方では、DDDだけの追加になっていますが・・・。
では、新規ブックに以下のコードで実行してみて下さい。
涙 さんが提示されたサンプルデータもコードで作成しました。
標準モジュールに
'========================================================
Option Explicit
Sub main()
Dim rng1 As Range
Dim rng2 As Range
Dim crng As Range
Dim nrw As Long
Call mk_sample_data
MsgBox "サンプルを Sheet1、Sheet2に作成しました。ここから、処理実行です。"
'Sheet1がシートＡSheet2がシートＢに相当します
With Worksheets("sheet1")
Set rng1 = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
End With
With Worksheets("sheet2")
Set rng2 = .Range("b2", .Cells(.Rows.Count, "b").End(xlUp))
End With
If rng1.Row > 1 Then
If rng2.Row > 1 Then
nrw = 0
For Each crng In rng1
If Evaluate("=SUM(EXACT(" & rng2.Address(, , , True) & "," & crng.Address(, , , True) & ")*1)") = 0 Then
With rng2
.Cells(.Rows.Count + 1 + nrw, 1).Resize(, 2).Value = crng.Resize(, 2).Value
.Cells(.Rows.Count + 1 + nrw, 3).Value = 1000
End With
nrw = nrw + 1
End If
Next
Else
With rng2
.Cells(2, 1).Resize(rng1.Rows.Count, 2).Value = rng1.Resize(, 2).Value
.Cells(2, 3).Resize(rng1.Rows.Count).Value = 1000
End With
End If
End If
End Sub
'=============================================================
Sub mk_sample_data()
With Worksheets("sheet1")
.Range("a1:c5").Value = _
[={"ID1","ID2","氏名";"AAA",111,"中田";"BBB", 222,"宮本";"CCC",333,"中村";"DDD",444,"川口"}]
End With
With Worksheets("sheet2")
.Range("a1:d4").Value = _
[={"年月日","ID1","ID2","料金";"6月1日","AAA",111,6300;"6月3日","BBB",222,3000;"6月5日","CCC",333,4000}]
.Range("a5:d8").Value = _
[={"6月7日","AAA",111,9000;"6月10日","CCC",333,4000;"6月12日","BBB",222,8000;"6月20日","AAA",111,7000}]
End With
End Sub
これで結果を確認してみて下さい。
あくまでも新規ブックで確認して下さい
|
|
ichinose
- 06/7/15(土) 15:10 -
