Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
重複データの追加
投稿日時: 23/07/17 16:31:13
投稿者: ひろまさ

先日よりご教示をして頂いており大変ご迷惑をお掛けしております。
以下のパターンについてご教示のお願いがございます。
マスタシートの図番を読込んで、入力シートの図番と一致したら
マスタシートの新図番と数量に置換えます。
しかし、マスタシートに図番が重複している場合、次の新図番と数量を
入力シートの最後に追加する処理です。(重量の値はそのまま転記)
  
例:
  
■マスタシート
図番 新図番 数量
222  222  30
111  333  10
111  444  20
666  666  30
  
■入力シート
図番  数量 重量
222   10  1
111   20  2
555   10  5
666   20  5
  
  ↓結果
  
■入力シート
図番  数量 重量
222   30  1
333   10  2
555   10  5
666   30  5
444   20  2
  
以下は以前、ご教示して頂いたコードを一部修正させて頂きました。
書籍、ネットで検索を行い確認をしましたが、どうすれば下記のコードに
追加すればよいのか今朝から止まっています。
大変申し訳ございませんが、アドバイスを頂けないでしょうか。
  
Sub test()
  
Dim he As Worksheet, sh2 As Worksheet
Dim i As Long, j As Long, strSR As Long
Dim s As String
Dim dic As Object
  
Set he = ThisWorkbook.Sheets(1)   'マスタシート
Set sh2 = ThisWorkbook.Sheets(2)  '入力シート
  
Set dic = CreateObject("Scripting.Dictionary")
With he
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            dic(.Cells(i, 1).Value) = i
    Next
End With
              
With sh2
    For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        s = .Cells(j, 1).Value
        If dic.Exists(s) Then
            i = dic(s)
            .Cells(j, 1) = he.Cells(i, 2) '図番
            .Cells(j, 2) = he.Cells(i, 3) '数量
          If マスタに図番が重複している場合
            strSR = sh2.Range("A1").End(xlDown).Row + 1
            .Cells(strSR, 1) = he.Cells(i, 2) '図番
            .Cells(strSR, 2) = he.Cells(i, 3) '数量
            .Cells(strSR, 3) = .Cells(j, 3)  '重量
          End If
        End If
    Next
End With
  
End Sub
  
よろしくお願い致します。

回答
投稿日時: 23/07/17 19:54:20
投稿者: simple

こんなことでしょうか。
 

Sub test()
    Dim wsM   As Worksheet
    Dim wsD   As Worksheet
    Dim dic   As Object
    Dim s     As String
    Dim t     As String
    Dim ary   As Variant
    Dim i As Long, j As Long, r As Long, k As Long

    Set wsM = ThisWorkbook.Sheets(1)    'マスタシート
    Set wsD = ThisWorkbook.Sheets(2)    '入力シート

    Set dic = CreateObject("Scripting.Dictionary")
    With wsM
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            s = .Cells(i, 1).Value
            If Not dic.Exists(s) Then
                dic(s) = CStr(i)
            Else
                dic(s) = dic(s) & "," & CStr(i)
            End If
        Next
    End With

    With wsD
        For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            s = .Cells(j, 1).Value
            If dic.Exists(s) Then
                t = dic(s)
                If InStr(t, ",") = 0 Then
                    i = CLng(t)
                    .Cells(j, 1) = wsM.Cells(i, 2)    '図番
                    .Cells(j, 2) = wsM.Cells(i, 3)    '数量
                Else    '対応するデータがマスターにある場合
                    ary = Split(t, ",")
                    i = CLng(ary(0))
                    .Cells(j, 1) = wsM.Cells(i, 2)    '図番
                    .Cells(j, 2) = wsM.Cells(i, 3)    '数量
                    For k = 1 To UBound(ary)
                        i = CLng(ary(k))
                        r = wsD.Cells(Rows.Count, "A").End(xlUp).Row + 1
                        .Cells(r, 1) = wsM.Cells(i, 2)    '図番
                        .Cells(r, 2) = wsM.Cells(i, 3)    '数量
                        .Cells(r, 3) = .Cells(j, 3)   '重量
                    Next
                End If
            End If
        Next
    End With
End Sub

# 余り念入りな検証はしていませんので、そちらでよく確認してください。

回答
投稿日時: 23/07/17 20:00:27
投稿者: simple

上記の回答は、データ件数もわかりませんし、速度面での工夫は特にしていません。
さほど遅くなるとは思いませんが。
 
なお、前回のスレッドですが、ポイントをもう一度コメントしておきます。
今後の参考にしてください。
 
1 多数のセル書き込みがある場合、一つ一つをセルに書き込むのではなく、
   配列としてまとめて書き込むと、速度向上の効果があります。
2 読み込む際にも配列として読み込むと、速度向上の効果があります。
3 1と2を比較すると、1の書き込みの工夫の効果は、2に比べて圧倒的に大きい。
4 辞書を利用すると、検索の高速化が図られます。
 
実は、あなたの過去のdictionaryを使った質問を見ていたので、
私は最初から4に触れました。
ただ、質問への回答としては、hatenaさんの回答が適切なものでした。
 
なお、私のコードで瞬時に終了したそうですが、それは、マスターのうち
A列が 消しゴム であるデータが極めて少件数だからでしょう。
余り適当なことでまとめないほうがよいでしょう。
 
そもそも、マスターだけでなく入力シートにも商品コードがあったのこと。
殆ど無意味な設定の議論をしていたことになります。
質問にあたっては、もう少し適切なものになるようによく考えて頂きたいものです。

回答
投稿日時: 23/07/18 06:14:12
投稿者: simple

コメントが間違っていました。
× '対応するデータがマスターにある場合
〇 '対応する図番がマスターに複数ある場合

投稿日時: 23/07/18 12:10:46
投稿者: ひろまさ

simple様
大変遅くなりましたが、お返事ありがとうございました。
コードの内容を参考にさせて頂きながら、作成を行うと同時に改めて
コメントに対して学習をさせて頂きます。
ありがとうございました。
 
言い分けになりますが、最初は配列で挑戦を試みました。
しかし、複数のシートで処理を行った際に配列の初期化を
行いましたがうまくいかず、simpleにご教示して頂いたコードで
「dic.RemoveAll」を追加する事でクリアできたので、参考に
させて頂きました。
配列の初期化についても後程、再度確認を行います。
また、これも言い訳になりますが、約1万件のテストデータの作成を
行い、処理時間が短縮された事も理由です。
しかし、simple様が「もう少し適切なものになるようによく考えて
頂きたいものです」というのも事実です。
その点を考えずに、ご質問をさせて頂いた事に対して配慮が欠けて
いました。
大変申し訳ございませんでした。
今後もまずは、自身で調べてどうしても前に進まない時はご質問を
させて頂くと思いますがよろしくお願い致します。