VBA 貼付先にないデータのみ貼付する方法

Question

どなたか教えて頂ければと思います。

仕事の案件ベースでのシフト表を作成しております。案件情報一覧から必要なデータをLOOPで引っ張る事までは出来たのですが、一度作成後に案件が追加となった場合全て上書きされてしまうため割振りした内容とズレが生じてしまう事に気がつきました。

そこで、一度作成したシフト表にある情報はスキップ(データ貼り付けさせない)＆新しい情報は最終行に追加する方法があれば教えて頂ければと思います。

備考？として、下記まとめておきます。
①案件が実行中のデータのみを抽出してシフト表へ転記している
②月の途中でも案件が募集中から実行中に変わる為、追加案件としてシフト表へ転記させることがある③新しい案件は最終行に追加させたい

現在つけているVBAを下記、記載しますのでご指摘、ご教授頂ければと思います。

---------------------

Sub シフト表≪案件ベース≫()

 
    '使用シートの設定
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet
    
    Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\案件情報一覧.xlsm")
    Set wb2 = Workbooks("シフト表.xlsm")
    Set sh1 = wb1.Worksheets("案件一覧")
    Set sh2 = wb2.Worksheets("案件ベース原紙")
    Set sh3 = wb1.Worksheets("☆")
    
    '実行中データの抽出
    sh1.Range("$A$6:$AH$10000").AutoFilter Field:=2, Criteria1:="=実行中"
    sh1.Range("A7").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy sh3.Range("A1")
     
     
        Dim i As Long: i = 3 '案件情報のDim
        Dim k As Long: k = 6 'シフト表のDim
        
        
     With sh2
     
        Do While sh3.Cells(i, 3).Value <> "" '繰り返す処理
            
            .Cells(k, 3).Value = sh3.Cells(i, 3).Value
            .Cells(k, 4).Value = sh3.Cells(i, 4).Value
            .Cells(k, 5).Value = sh3.Cells(i, 13).Value
            .Cells(k, 6).Value = sh3.Cells(i, 15).Value
            .Cells(k, 7).Value = sh3.Cells(i, 7).Value
            .Cells(k, 8).Value = sh3.Cells(i, 8).Value
                    
        i = i + 1: k = k + 1
        
        Loop
      
      End With
  
    'シートを閉じる
    wb1.Close savechanges:=False


End Sub

GooUserラック · Accepted Answer

こんな感じはいかがでしょうか？

Sub シフト表≪案件ベース≫()

Dim A_Dic As Object '案件コード⇒行番号対応辞書
'使用シートの設定
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet

Set A_Dic = CreateObject("Scripting.Dictionary")
　Set wb2 = ThisWorkbook
　Set sh2 = wb2.Worksheets("案件ベース原紙")

Dim k As Long 'シフト表の行番号
Dim S_ERow As Long 'シフト表の最終行番号
'案件コード辞書に行番号を登録
　sh2.Activate
　S_ERow = Cells(Rows.Count, 3).End(xlUp).Row
　If S_ERow <= 5 Then Exit Sub
　For k = 7 To S_ERow
　　If A_Dic.Exists(Cells(k, 3).Value) = False Then
　　　A_Dic.Add Cells(k, 3).Value, k
　　End If
　Next
　
　Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\案件情報一覧.xlsm")
　Set sh1 = wb1.Worksheets("案件一覧")

'実行中データの抽出

Dim i As Long '案件情報の行番号
Dim A_ERow As Long '案件一覧の最終行番号
　sh1.Activate
　A_ERow = Cells(Rows.Count, 3).End(xlUp).Row
　For i = 7 To A_ERow
　　If Cells(i, 2).Value = "実行中" Then
　　　If A_Dic.Exists(Cells(i, 3).Value) Then
　　　　k = A_Dic.Item(Cells(i, 3).Value)
　　　Else
　　　　S_ERow = S_ERow + 1
　　　　k = S_ERow
　　　　A_Dic.Add Cells(i, 3).Value, k
　　　End If
　　　With sh2
　　　　.Cells(k, 3).Value = Cells(i, 3).Value
　　　　.Cells(k, 4).Value = Cells(i, 4).Value
　　　　.Cells(k, 5).Value = Cells(i, 13).Value
　　　　.Cells(k, 6).Value = Cells(i, 15).Value
　　　　.Cells(k, 7).Value = Cells(i, 7).Value
　　　　.Cells(k, 8).Value = Cells(i, 8).Value
　　　End With
　　End If
　Next

'シートを閉じる
wb1.Close savechanges:=False

End Sub

GooUserラック · Answer

No.6 の訂正

大変申し訳ございません
「For k = 7 To S_ERow」を「For k = 6 To S_ERow」に変更して下さい。

fujillin · Answer

No2です

＞認識としてはあってますか？？
その通りです。
ご質問の場合は、「既存のデータと一致しないデータ」を追加で貼付けすればよいのだと思います。
No2の回答は、何らかのID（データの識別子）が存在することを仮定したものですが、その点は問題がないものとして、以下簡単に説明しておきます。

別回答のコードの処理のおおまかな手順は、
　1）シート内の作業列にできる列を設定（最終列）
　2）作業列に関数（後述）を設定。
　　この結果、「すでに存在するか/しないか」が計算されます
　3）上記の結果で、必要なデータをオートフィルタ
　4）フィルタされたデータをコピペ
のようなものです。

＞f=”〜のところです。
変数fには関数式（文字列）を設定しています。
通常のシートに直接関数を記入することを考えると
　=COUNTIF(既存のデータリスト, 調べたいデータ)
とすることで、そのデータが既にリストに掲載済みであるかどうかがわかります。
無ければ0、あれば1以上の数が返ります。

既出のマクロでは、
　=(COUNTIF(既存のデータリスト, 調べたいデータ)>0)*1
として、有→1、なし→0 という結果になるようにしています。
（*1は無くて、TRUE、FALSE の結果でも十分なのですが）
さらに、「調べたいデータ」が必ず存在するのか（空白の場合がないのか）質問文からでは不明でしたので、念のために、
　=IF(調べたいデータ="","",COUNTIF(～～))
という形式の式にすることで、空白のデータが紛れ込まないようにしています。
（空白が無いことがはっきりしていれば、複雑化する必要はないのですが…）

「f=～」の部分は、リストの範囲等が固定ではないため、その時のシートの状態に合わせた関数式を（文字列で）作成する処理を行っています。

※ 他の回答を例に抽象的な説明になってしまっているので、わかり難いとは思いますが、質問者様のケースでのセル位置やセル範囲が明確ではないので、やむを得ずこのような説明になっていることをご理解願います。

GooUserラック · Answer

このマクロですがコードを見る限り「シフト表.xlsm」に有るようですが、写真を見ると「案件一覧」シートですよね？そのシートは「案件情報一覧.xlsm」に有るんですよね？
写真に写っている「作成」ボタンは何でしょうか？

GooUserラック · Answer

①「案件情報」「シフト表」どちらもデータは７行目から始まるという認識でよろしいですか？
② 一度転記されたものは「募集ステータス」が変わってもそのまま残すという認識でよろしいですか？
③「☆」シートは作業用にしか使っていないようですが、代用出来たら「☆」シートは不要と考えても良いですか？（範囲を決めて一機に張付け出来ないのでフィルターを使う意味があまりない）

fujillin · Answer

こんにちは

No1様も質問なさっていますが、各データ（=行)を識別できるIDに該当するデータは存在しないのでしょうか？
存在しない場合は、同一性を識別するのに全データを比べてみるというあやふやな方法しかとれないと思いますので、処理の確実性が失われますし、いたずらに時間が掛かる可能性もでてきます。

もしも、IDが存在するなら、先ほど回答した別の質問と（意味的に）同じと考えることができます。
https://oshiete.goo.ne.jp/qa/11459160.html

上記の「コード一覧」に当たるのが、ご質問の「シフト表」ということになります。
『シフト表に記載が無いデータだけ抜き出してコピペする』
（↑）の質問では「存在するものも別のシートへコピペ」するようになっていますが、この処理は不要ですね。
コピペのペースト先を「別のシート」ではなく「シフト表」にして、最終行以降に追加するようにすれば、他に関してはまったく同じ内容として考えることができるはずです。

GooUserラック · Answer

レイアウトが判らないので具体的なアドバイスは出来ません。
重複しているか判定するためのキーはどの列に有るのでしょうか？
（キーになるのは一般的には社員番号とかですが、同姓同名が絶対にいなければ氏名を使う事もあると思います）

VBA 貼付先にないデータのみ貼付する方法

こんな感じはいかがでしょうか？

No.6 の訂正

No2です

このマクロですがコードを見る限り「シフト表.xlsm」に有るようですが、写真を見ると「案件一覧」シートですよね？そのシートは「案件情報一覧.xlsm」に有るんですよね？

①「案件情報」「シフト表」どちらもデータは７行目から始まるという認識でよろしいですか？

こんにちは

レイアウトが判らないので具体的なアドバイスは出来ません。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング