Znajdź dwa różne arkusze Excela, jeśli mają identyczny wiersz


0

Mam dwa arkusze programu Excel z tą samą nazwą kolumny i formatem. I ma jeden identyczny wiersz (może być użyty jako klucz podstawowy) id. Chcę dostać różnicę.

Tabela 1:

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

Tabela 2:

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

Tabela wyników:

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

Chcę zapełnić tabelę wyników tylko zaktualizowanymi i nowymi wierszami. (Możemy zidentyfikować wiersz za pomocą klucza podstawowego)

Czy jest jakaś funkcja bezpośrednio, aby uzyskać różnicę w programie Excel (WYSZUKAJ.PIONOWO)?

Jeśli nie, jak mogę napisać zapytanie w programie Access, aby to zrobić?


Czy chcesz wywołać zaktualizowane i nowe rekordy? czy po prostu chcesz uzyskać pełną listę różnych rzeczy?
Brad

Odpowiedzi:


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

Zakładając, że Twoje dane znajdują się w Arkuszu 1, załączona formuła da wyniki Nowe / Uaktualnione lub Blankjeśli skopiujesz je na prawo od tabeli 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",""))

Korzystając z naszej strony potwierdzasz, że przeczytałeś(-aś) i rozumiesz nasze zasady używania plików cookie i zasady ochrony prywatności.
Licensed under cc by-sa 3.0 with attribution required.