ママのスキンケアのお悩みにおすすめアイテム

いつもお世話になっております。
Excel2016を使用しています。
二つのリストを比べているのですが下記のようなことができるか教えてください。
データは開始行は両方とも2行目、お互い最終行まで比較したいです。
また、日付と名前の組み合わせをキーとしたものに重複、空白はないですが、他の列に空白はあります。

sheet1(直電)
B列…名前
C列…日付
D列…電話番号
H列…内容
I列…対応

sheet2(SC受付)
C列…名前
E列…日付
H列…電話番号
J列…内容
K列…対応

sheet3(まとめ)
B列…名前
C列…日付
D列…電話番号
E列…内容
F列…対応
G列…備考

sheet3にsheet1とsheet2両方にあるものはG列・備考に「直電/SC」
sheet1のみは「直電」、sheet2のみは「SC」としたいです。
sheet3に内容をまとめるにはどうすればいいのかいきづまってしまい
どうかアドバイスをお願いします。


Sub test()
Dim myDic1 As Object
Dim myDic2 As Object
Dim i As Long, j As Long
Dim lastRow As Long, lastCol As Long
Dim wS1 As Worksheet, wS2 As Worksheet
Dim myKey, myItem, myR, myAry

Set myDic1 = CreateObject("Scripting.Dictionary")
Set myDic2 = CreateObject("Scripting.Dictionary")
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")

With Worksheets("Sheet3")

'sheet1の処理
lastRow = wS1.Cells(Rows.Count, "B").End(xlUp).Row 'B列:名前(空白なし)
myR = Range(wS1.Cells(2, "B"), wS1.Cells(lastRow, "I"))
For i = 1 To UBound(myR, 1)
If Not myDic1.Exists(myR(i, 1)) Then
myDic1.Add myR(i, 1), myR(i, 2)
Else
myDic1(myR(i, 1)) = myDic1(myR(i, 1)) & "_" & myR(i, 2) & "_" & myR(i, 3) & "_" & myR(i, 7) & "_" & myR(i, 8)
End If
Next i


'sheet2の処理
lastRow = wS2.Cells(Rows.Count, "C").End(xlUp).Row 'C列:名前(空白なし)
myR = Range(wS2.Cells(2, "C"), wS2.Cells(lastRow, "K"))
For i = 1 To UBound(myR, 1)
If Not myDic1.Exists(myR(i, 1)) Then
myDic1.Add myR(i, 1), myR(i, 3)
Else
myDic1(myR(i, 1)) = myDic1(myR(i, 1)) & "_" & myR(i, 3) & "_" & myR(i, 6) & "_" & myR(i, 8) & "_" & myR(i, 9)
End If
Next i

myKey = myDic2.Keys
myItem = myDic2.Items


'sheet3に内容をまとめたい…


End With
Set myDic1 = Nothing
Set myDic2 = Nothing
End Sub

「二つのリストを比べてまとめる方法について」の質問画像

A 回答 (7件)

投稿後気が付きました。


タイプミスです。
  'sheet2の処理
  For i = 1 To UBound(myR, 1)

正しくは、
'sheet2の処理
For i = 1 To UBound(myR1, 1)

わかり易い変数名にする。。
基本が出来ていませんでした。すみません。
    • good
    • 0
この回答へのお礼

助かりました

Qchan1962さんありがとうございました!
最初にアドバイスいただいたとき、結局どうすればいいんだろう?と途方にくれてたのですが
希望通りの形にすることができました!
ずっとこれに試行錯誤してたのでもう神かと(T▽T)
声を大にしてお礼を言いたいです!
ありがとうございました!!

お礼日時:2020/07/11 15:56

やっぱ初級レベルはコードがゴチャゴチャしちゃいますなぁ。


十数年何してたのかと思ってしまいます。
LINQに頼り過ぎたのが失敗なのか・・・?
    • good
    • 0
この回答へのお礼

ありがとう

コードまで書いていただきありがとうございました。試してみたのですが、下記のようになってしまいました。

項目
直電データ(1行)
項目
SCデータ(1行)

めぐみんさんは初級と言われますが、何回かアドバイスをいただいたことがあり、自分じゃまったく気づかない、知らないことだったりするので
いつもスゴいなぁと思ってます。アドバイスありがとうございました!

お礼日時:2020/07/11 15:52

こんばんは、#2です。


回答時になんかすっきりしなかったので、
少し書き直してみました。

少し変更していますが、ご質問にある処理の流れです。
基本添付図を参考にしましたが、コードには、A列が入っていないので、入れませんでした。
山本と鈴木がどうすればその順番になるのか、少し考えましたが、諦めました。
定数に関しては、適時変更してください。

突っ込みどころがあっても勘弁してくださいね。

Sub test()
Dim myDic As Object
Dim i As Long, n As Long
Dim wS1 As Worksheet, wS2 As Worksheet
Dim myKey, myR, myR1, myAry, myTmp
  Set myDic = CreateObject("Scripting.Dictionary")
  Set wS1 = Worksheets("Sheet1")
  Set wS2 = Worksheets("Sheet2")
  'sheet1の処理
  myR = Range(wS1.Cells(3, "B"), wS1.Cells(wS1.Cells(Rows.Count, "B").End(xlUp).Row, "I"))
  myR1 = Range(wS2.Cells(3, "C"), wS2.Cells(wS2.Cells(Rows.Count, "C").End(xlUp).Row, "K"))
  For i = 1 To UBound(myR, 1)
    myKey = myR(i, 1) & myR(i, 2)
    If Not myDic.Exists(myKey) Then
      myDic.Add myKey, myR(i, 1) & "_" & myR(i, 2) & "_" & myR(i, 3) & "_" & myR(i, 7) & "_" & myR(i, 8) & "_" & "直電"
    End If
  Next i
  Set wS1 = Nothing
  'sheet2の処理
  For i = 1 To UBound(myR, 1)
    myKey = myR1(i, 1) & myR1(i, 3)
    If Not myDic.Exists(myKey) Then
      myDic.Add myKey, myR1(i, 1) & "_" & myR1(i, 3) & "_" & myR1(i, 6) & "_" & myR1(i, 8) & "_" & myR1(i, 9) & "_" & "SC"
    Else
      myDic(myKey) = myR1(i, 1) & "_" & myR1(i, 3) & "_" & myR1(i, 6) & "_" & myR1(i, 8) & "_" & myR1(i, 9) & "_" & "直電/SC"
    End If
  Next i
  Set wS2 = Nothing
  ReDim myAry(UBound(myDic.Keys), 5)
  For Each myKey In myDic.Items
    If Not IsEmpty(myKey) Then
      myTmp = Split(myKey, "_")
      For i = 0 To UBound(myTmp)
        myAry(n, i) = myTmp(i)
      Next
      n = n + 1
    End If
  Next
  Set myDic = Nothing
  'sheet3に内容をまとめたい…
  With Worksheets("Sheet3")
    .Cells.ClearContents
    .Range("A2:G2").Value = Array("No", "名前", "日付", "電話番号", "内容", "対応", "備考")
    .Range("B3").Resize(UBound(myAry, 1) + 1, 6) = myAry
    .Range("B3:G" & .Cells(Rows.Count, "B").End(xlUp).Row).Sort key1:=.Range("C3"), Order1:=xlAscending
  End With
End Sub
    • good
    • 0

違ってたらスル~してくださいな。



Sub megu()
Dim myDic As Object
Dim r As Range, st As String, n As Integer
Dim c1, c2, i, v(1 To 7), vv

Set myDic = CreateObject("Scripting.Dictionary")

c1 = Array(1, 2, 3, 4, 8, 9)
c2 = Array(1, 3, 5, 8, 10, 11)

With Worksheets("Sheet1")
For Each r In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
st = r.Range("B1").Value & "_" & r.Range("C1").Text
myDic.Add st, v
vv = myDic(st)
n = 1
For Each i In c1
vv(n) = .Cells(r.Row, i).Text
n = n + 1
Next
vv(7) = "直電"
myDic(st) = vv
Next
End With

With Worksheets("Sheet2")
For Each r In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
st = r.Range("C1").Value & "_" & r.Range("E1").Text
If myDic.Exists(st) Then
vv = myDic(st)
vv(7) = vv(7) & "/SC"
myDic(st) = vv
Else
myDic.Add st, v
vv = myDic(st)
n = 1
For Each i In c2
vv(n) = .Cells(r.Row, i).Text
n = n + 1
Next
vv(7) = "SC"
myDic(st) = vv
End If
Next
End With

With Worksheets("Sheet3")
.Cells.ClearContents
.Range("A1:G1").Value = Array("No", "名前", "日付", "電話番号", "内容", "対応", "備考")
.Range("A2").Resize(myDic.Count, 7).Value = Application.Transpose(Application.Transpose(myDic.Items))
End With

Set myDic = Nothing

End Sub
    • good
    • 0

No.1です。



key はともかく item は配列を使用した方が楽だと思いますよ。
AccessがあるならSQLで書けるでしょうけど、なんかちょっと前に未インストールの質問で環境の違いか上手くいかなかったらしいのがショックで落ち込んではいますけどね。
    • good
    • 0

こんにちは、


>sheet3にsheet1とsheet2両方にあるものはG列・備考に「直電/SC」sheet1のみは「直電」、sheet2のみは「SC」としたいです。
Ifで書くと、どうなります?
では、この条件を充たす処理部分は、どこでしょう。

Splitで出力項目を分け書き込んでいると推測しますが、そうであれば、書き込みたいワードを増やせば良いかと思います。
(実際に増えている)
ご質問のコードでうまく実行できているのなら、例えば、
>sheet1のみは「直電」
'sheet1の処理
myWord="直電"
myDic1(myR(i, 1)) = myDic1(myR(i, 1)) & "_" & myR(i, 2) & "_" & myR(i, 3) & "_" & myR(i, 7) & "_" & myR(i, 8) & "_" & myWord

ご質問のコードは、なんかしっくりしない気がしますが、該当箇所に加えれば、出来るのではないでしょうか。
>日付と名前の組み合わせをキー  myR(i, 1) & myR(i, 2) みたいに出来ないのかな、、と思いました。
    • good
    • 0

初級者ですがちょっと気になったので。



比較して一つにするならDictionaryを2つ宣言する必要はなく1つ目を読み込んだ結果と次のシートの内容を比較し書き換えるのではないかなと。
ようは1つ目のシートのデータを3つ目のシートのデータ区分に配置してってのが必要ではないかな~と感じました。

ただその方法はVBA的な物ではないとの指摘でしたので直接の回答は避けますけど。
    • good
    • 0

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

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


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

人気Q&Aランキング