アプリ版:「スタンプのみでお礼する」機能のリリースについて

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件)

こんばんは



>色々ネットで調べて作成してみたのですが、~~上手くいかず
単純に「できる/できない」の二択で言われても、何がわからないのか、どこが悪いのかなどはまったくわかりません。
ご質問の内容も丸投げの「作ってちょーだい!」形式なので、回答が得られたとしても、単なる「ブラックボックス」を得るだけで、メンテも修正も不可能なのではないかと懸念します。
(多少の違いがあっても「できる/できない」でしか判断なさらないのではと想像します)


とりあえず、以下は最低限の処理の一例です。
※ 最低限なので、データの整合性のチェック等は行っていません。
 (質問文にある形式のデータのみが存在すると仮定しています)
※ ノーチェックなので、データに空白行があったり、規定形式外のデータが
 存在すると、エラーが発生する可能性があります。

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
    • good
    • 0

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
    • good
    • 0

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

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


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