同一の行がある場合に異なる2つのExcelシートを見つける


0

同じ列名と形式の2つのExcelシートがあります。そして、1つの同一の行があります(主キーとして使用できます)id。差分を取得したい。

表1:

 id   Name   GPA 
----+------+-------
 1  | AA   |  3
 2  | BB   |  2
 3  | CC   |  3
 4  | DD   |  1

表2:

 id   Name   GPA 
----+------+-------
 4  | DD   |  2               (updated)
 7  | YY   |  2               (New)
 1  | AA   |  3                  _
 2  | DD   |  2               (Updated)  

結果表:

     id   Name   GPA 
    ----+------+-------
     4  | DD   |  2               
     7  | YY   |  2                    
     2  | DD   |  2   

更新された行と新しい行のみを結果テーブルに追加したい。(主キーを使用して行を識別できます)

Excel(VLOOKUP)の違いを直接取得する関数はありますか?

そうでない場合、Accessでクエリを作成してこれを実行できますか?


更新されたレコードと新しいレコードを呼び出しますか?または、さまざまなものの完全なリストを取得したいだけですか?
ブラッド

回答:


1
Option Explicit

Sub PutChangedRecordsIntoSomewhere()
    Dim rs As ADODB.Recordset
    Set rs = FindChangedRecords(ThisWorkbook.Path & "\" & ThisWorkbook.Name)
    Dim destSheet As Worksheet
    Set destSheet = Sheets("Sheet3")
    destSheet.Range("A2").CopyFromRecordset rs

    rs.Close
    Set rs = Nothing
End Sub



Public Function FindChangedRecords(WorkbookPath As String) As ADODB.Recordset

    Dim rst As New ADODB.Recordset
    Dim cnx As New ADODB.Connection
    Dim cmd As New ADODB.Command

    'setup the connection
    With cnx
        On Error Resume Next
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source='" & WorkbookPath & "'; " & "Extended Properties='Excel 12.0;HDR=Yes;IMEX=1'"
        .Open
        If Err.Number <> 0 Then
            MsgBox Err.Description
            Set FindChangedRecords = Nothing
            Exit Function
        End If
        On Error GoTo 0
    End With

    'setup the command
    Set cmd.ActiveConnection = cnx
    cmd.CommandType = adCmdText
    cmd.CommandText = "Select s2.* " & _
                "from [Sheet2$] s2 " & _
                "left join [Sheet1$] s1 on s1.id = s2.id and s1.name = s2.name and s1.gpa = s2.gpa " & _
                "where s1.id is null"   '<-- change sheet2 to where your "table2" is
                                        '<-- change sheet1 to where your "table1" is

    rst.CursorLocation = adUseClient
    rst.CursorType = adOpenDynamic
    rst.LockType = adLockOptimistic
    'open the connection
    rst.Open cmd

    'disconnect the recordset
    Set rst.ActiveConnection = Nothing
    'cleanup
    If CBool(cmd.State And adStateOpen) = True Then
        Set cmd = Nothing
    End If

    If CBool(cnx.State And adStateOpen) = True Then cnx.Close
    Set cnx = Nothing

    'return the recordset object
    Set FindChangedRecords = rst


End Function

1

データがSheet1にあると仮定すると、添付の数式は、新規/更新の結果、またはBlank表2の右側にコピーした場合の結果を示します。

=IF(ISNA(MATCH(A2,Sheet1!$A:$A,0)),"New",IF(OR(VLOOKUP($A2,Sheet1!$A:$C,2,0)<>$B2,VLOOKUP($A2,Sheet1!$A:$C,3,0)<>$C2),"Updated",""))

弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.