Excelマクロにて、シートの差分抽出に関する質問です。
色々ネットで調べて作成してみたのですが、初心者のため上手くいかず、ご質問させていただきました。 シート1に新データ、シート2に前回データを貼り付けてシート3に差分データを抽出したいです。
データ例
$$管理番号$名前$ID$生年月日$データ作成日付$区分
※1.2行目はヘッダー。
新データ(シート1)
$$Y038237$鈴木例人$1$1993/04/17$2023/02/01$01$
$$Y038237$鈴木例人$1$1993/04/17$2023/02/20$02$ 抽出
$$F073841$田中例男$1$1968/11/21$2023/01/31$06$
$$A048510$池田例実$2$1982/05/16$2023/02/01$02$ 抽出
$$W019936$小林例時$1$1995/01/09$2023/02/20$01$
$$G047109$山田例子$2$1971/08/13$2023/02/11$02$ 抽出
$$W019936$山本例平$1$1990/11/09$2023/02/01$01$
$$W019936$山本例平$1$1990/11/09$2023/02/25$01$
$$W019936$山本例平$1$1990/11/09$2023/02/27$01$ 抽出
旧データ(シート2)
$$Y038237$鈴木例人$1$1993/04/17$2023/02/01$01$
$$F073841$田中例男$1$1968/11/21$2023/01/31$06$
$$W019936$小林例時$1$1995/01/09$2023/02/20$01$
$$W019936$山本例平$1$1990/11/09$2023/02/01$01$
$$W019936$山本例平$1$1990/11/09$2023/02/25$01$
差分データ(シート3)
$$Y038237$鈴木例人$1$1993/04/17$2023/02/20$02$
$$A048510$池田例実$2$1982/05/16$2023/02/01$02$
$$G047109$山田例子$2$1971/08/13$2023/02/11$02$
$$W019936$山本例平$1$1990/11/09$2023/02/27$01$
となっており、A列だけに入力されてます。($マークで区切られている)
[管理番号]と[データ作成日付]を軸にして比較し、新データで新しく追加されたデータをシート3に抽出したいです。
すみません、ワガママを言うとシート3に抽出したデータをcsvファイルで書き出しするコードも教えていただけると幸いです。
上記のことが出来るコードを教えていただけないでしょうか。
宜しくお願いいたします。
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
Sub CompareSheets()
Dim wb As Workbook
Dim wsNew As Worksheet
Dim wsOld As Worksheet
Dim wsDiff As Worksheet
Dim lastRowNew As Long
Dim lastRowOld As Long
Dim i As Long, j As Long, k As Long
Dim foundMatch As Boolean
Set wb = ThisWorkbook
Set wsNew = wb.Sheets("シート1")
Set wsOld = wb.Sheets("シート2")
Set wsDiff = wb.Sheets("シート3")
lastRowNew = wsNew.Cells(wsNew.Rows.Count, "A").End(xlUp).Row
lastRowOld = wsOld.Cells(wsOld.Rows.Count, "A").End(xlUp).Row
'ヘッダーをシート3にコピー
wsNew.Rows(1).Copy wsDiff.Rows(1)
k = 2 '最初の行はヘッダーなので、2行目からスタート
'新しいデータを順番にチェック
For i = 2 To lastRowNew
foundMatch = False
'以前のデータと比較
For j = 2 To lastRowOld
If wsNew.Cells(i, 1) = wsOld.Cells(j, 1) And wsNew.Cells(i, 5) > wsOld.Cells(j, 5) Then
'管理番号が一致しているかつ、新しいデータの作成日付が古い場合
foundMatch = True
Exit For
End If
Next j
If Not foundMatch Then
'差分をシート3にコピー
wsNew.Rows(i).Copy wsDiff.Rows(k)
k = k + 1
End If
Next i
'シート3のデータをCSVファイルとして保存
wsDiff.SaveAs ThisWorkbook.Path & "\差分データ.csv", xlCSV
MsgBox "差分データをシート3に抽出し、CSVファイルに保存しました。", vbInformation
End Sub
No.2
- 回答日時:
こんばんは
>色々ネットで調べて作成してみたのですが、~~上手くいかず
単純に「できる/できない」の二択で言われても、何がわからないのか、どこが悪いのかなどはまったくわかりません。
ご質問の内容も丸投げの「作ってちょーだい!」形式なので、回答が得られたとしても、単なる「ブラックボックス」を得るだけで、メンテも修正も不可能なのではないかと懸念します。
(多少の違いがあっても「できる/できない」でしか判断なさらないのではと想像します)
とりあえず、以下は最低限の処理の一例です。
※ 最低限なので、データの整合性のチェック等は行っていません。
(質問文にある形式のデータのみが存在すると仮定しています)
※ ノーチェックなので、データに空白行があったり、規定形式外のデータが
存在すると、エラーが発生する可能性があります。
Sub Q_13390303()
Dim D, D1, D2(), u As Range
Dim i As Long, j As Long
With Worksheets("シート2")
D1 = .Cells(1, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
ReDim D2(1 To UBound(D1), 1 To 2)
For i = 1 To UBound(D1)
D = Split(D1(i, 1), "$")
D2(i, 1) = D(2)
D2(i, 2) = D(6)
Next i
With Worksheets("シート3")
.Cells.ClearContents
.Columns(1).Value = Worksheets("シート1").Columns(1).Value
For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
Set D1 = .Cells(i, 1)
D = Split(D1.Value, "$")
For j = 3 To UBound(D2)
If D2(j, 1) = D(2) And D2(j, 2) = D(6) Then
If u Is Nothing Then Set u = D1 Else Set u = Union(u, D1)
Exit For
End If
Next j
Next i
If Not u Is Nothing Then u.EntireRow.Delete
End With
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- Excel(エクセル) Excelについて教えてください。 帳票データがあります。 アクセスに取り込むため、 データ形式にし 1 2022/06/08 19:59
- Excel(エクセル) 複数セルデータを別シートの単一セルにコピーしたい。(詳細をご参照ください) 1 2022/12/14 15:08
- Excel(エクセル) Excelの関数でこんな処理ができますか 1 2023/02/08 13:46
- Visual Basic(VBA) 複数シートの複数列に入力されているデータを重複なしで抽出するVBAを作りたいです。 9 2022/06/17 10:33
- Excel(エクセル) マクロか関数で処理したいのですが、教えて頂けませんか。 8 2022/10/31 15:18
- C言語・C++・C# このプログラミングの問題を教えてほしいです。 キーボードからデータ数nとn個のデータを入力し、平均値 3 2022/12/19 22:51
- Excel(エクセル) EXCEL 関数を教えてください。(A列の同じ値が複数ある場合vlookupで出来ますか) 4 2022/12/07 20:54
- Visual Basic(VBA) 集計シートA列のコードと一致する右に並んだシート名(コード)の3行目から10行目をコピーして貼り付け 4 2022/08/18 15:24
- Visual Basic(VBA) エクセルについて教えてください。 3 2023/06/28 09:11
このQ&Aを見た人はこんなQ&Aも見ています
-
新NISA制度は今までと何が変わる?非課税枠の拡大や投資対象の変更などを解説!
少額から投資を行う人のための非課税制度であるNISAが、2024年に改正される。おすすめの銘柄や投資額の目安について教えてもらった。
-
Excelマクロ 差分抽出の方法が知りたいです。
Excel(エクセル)
-
更新前と更新後の差分をVBAを使って抜き出したい
Excel(エクセル)
-
VBAでのリスト不一致抽出について
Visual Basic(VBA)
-
-
4
Excel VBAで比較して数値があってなかったらセルの色を変換
Visual Basic(VBA)
-
5
エクセルVBAで 2種のリストを比べて重複していないデータを最下行に追加するには
Excel(エクセル)
-
6
エクセルVBAでセルに入力したパスでブックを開く
Excel(エクセル)
-
7
excel VBA 2つのシートの特定の列を比較して同じ値のセルがあったらその行を上書きしたい
Excel(エクセル)
-
8
エクセルVBAで、ある文字を含んでいたら別シートに抽出したい
Excel(エクセル)
-
9
targetをA列のセルに限定するには?
Visual Basic(VBA)
-
10
【VBA】異なる行だけを抜き出す数式/マクロについて
Visual Basic(VBA)
-
11
VBAでセル入力の数式に変数を用いたい
Excel(エクセル)
-
12
Excel VBA:セルを新旧1つずつ比較して同分を上書き、差分を蓄積追加
Excel(エクセル)
-
13
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
-
14
【Excel VBA】先頭の「0」飛びを埋める方法
Visual Basic(VBA)
-
15
Rangeメソッドは失敗しました。globalオブジェクトについて
Excel(エクセル)
-
16
エクセルエラー13型が一致しませんの直し方教えて下さい。
その他(Microsoft Office)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル初心者です 関数の入れ...
-
【関数】先頭だけにある、半角...
-
エクセル 白黒印刷で白線を印刷...
-
Excelのチェックボックスの使い...
-
【関数】適切な文字数の数字を...
-
Excelのpivotについて質問です
-
Excel ピボットテーブルで日付...
-
LOOKUP関数を使えばいいのでし...
-
エクセル関数を教えてください
-
エクセルのセルに同じ大きさの...
-
UNIQUE関数が使えないバージョ...
-
excelの不要な行の削除ができな...
-
エクセルで「-0.0」と表示さ...
-
時間によってファイル名が変わ...
-
WPS OFFICEでの縦書きについて
-
エクセルの関数について教えて...
-
Aというブックの1というシート...
-
【マクロ】シート名を取得する...
-
VBA Private Sub Worksheet_Cha...
-
VBA、Excelのworkbook.open に...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel 2019 のピボットテーブル...
-
[関数得意な方]教えて下さい・...
-
Excelにてある膨大なデータを管...
-
[関数について]わかる方教えて...
-
Excel初心者です。 詳しい方、...
-
excelの不要な行の削除ができな...
-
エクセル関数に詳しい方教えて...
-
INDIRECTを使わず excelで複数...
-
[オートフィルタ]で抽出された...
-
エクセルの神よ、ご回答を! エ...
-
エクセル関数に詳しい方、教え...
-
各ページの1番上の表示について
-
Excelで写真のような表を作った...
-
エクセルで不等号記号(≠)が上に...
-
数学 Tan(θ)-1/Cos(θ)について...
-
Excel 2019 は、SPILL機能があ...
-
Excelで全角を半角にしたいので...
-
条件付き書式を教えてください
-
Excel フィルターを掛けた状態...
-
[オートフィルタ]の適用範囲の...
おすすめ情報