Macro pour comparer 2 workbook - Erreur

Le 30/03/2016 à 11:18

Bonjour,

Je cherche à comparer certaines colonnes des 2 tableaux dans 2 workbook différents et ressortir les différentes valeurs dans un nouveau fichier, par ex colonne B du wb 1 avec colonne C du wb 2, pourtant les données ne sont pas dans le meme ordre. J'ai fait le macro suivant et il y a un erreur out of range à la ligne "Redim result.." J'ai essayé de renverser les 2 arrays mais ça ne marche pas!

Merci d'avance de votre aide.

Option Explicit

Sub Find_Differents()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim data1, data2
    Dim header As Dictionary, data1_Dico As Dictionary, data2_Dico As Dictionary
    Dim different_Dico As Dictionary
    Dim key, tmp, result
    Dim transaction_Type As String, ISIN As String, NAV_Date As String, value_Date As String, nature As String, amount As String
    Dim i As Long, j As Long, lastRow As Long

    With ThisWorkbook.Sheets("Board")
        Set wb1 = Workbooks.Open(.Range("file_name_1"))
        data1 = ActiveSheet.Range("A1").CurrentRegion.Value
'        wb1.Close SaveChanges:=False
        Set wb2 = Workbooks.Open(.Range("file_name_2"))
        data2 = ActiveSheet.Range("A1").CurrentRegion.Value
'        wb2.Close SaveChanges:=False
    End With

    Set header = Get_Header_Dico(data1, 1)

    Set data1_Dico = New Dictionary
    For i = 2 To UBound(data1, 1)
        transaction_Type = data1(i, header("Transaction Type"))
        ISIN = data1(i, header("ISIN Code"))
        NAV_Date = Format(data1(i, header("NAV Date")), "dd/mm/yyyy")
        value_Date = Format(data1(i, header("Value Date")), "dd/mm/yyyy")
        nature = data1(i, header("Investment Type"))
        If nature = "Unit" Then
            amount = Format(data1(i, header("Share Nb.")), "#0.0000")
        ElseIf nature = "Amount" Then
            amount = Format(data1(i, header("Fund Amount (Client Cur.)")), "#0.0000")
        End If

        key = transaction_Type & "#" & ISIN & "#" & NAV_Date & "#" & value_Date & "#" & nature & "#" & amount
        If Not data1_Dico.Exists(key) Then
            data1_Dico.Add key, i
        End If
    Next i

    Set header = Get_Header_Dico(data2, 1)

    Set data2_Dico = New Dictionary
    For i = 2 To UBound(data2, 1)
        transaction_Type = data2(i, header("S/R type"))
        ISIN = data2(i, header("Fund share code"))
        NAV_Date = Format(data2(i, header("Pricing Date")), "dd/mm/yyyy")
        value_Date = Format(data2(i, header("Value Date")), "dd/mm/yyyy")
        nature = data2(i, header("Nature"))
        If nature = "Unit" Then
            amount = Format(data2(i, header("Quantity")), "#0.0000")
        ElseIf nature = "Amount" Then
            amount = Format(data2(i, header("Net amount")), "#0.0000")
        End If

        key = transaction_Type & "#" & ISIN & "#" & NAV_Date & "#" & value_Date & "#" & nature & "#" & amount
        If Not data2_Dico.Exists(key) Then
            data2_Dico.Add key, i
        End If
    Next i

    Set different_Dico = New Dictionary
    For Each key In data1_Dico.Keys
        If Not data2_Dico.Exists(key) Then
            different_Dico.Add key, key
        End If
    Next key

    ReDim result(1 To different_Dico.Count, 0 To 5)
    i = 0
    For Each key In different_Dico.Keys
        tmp = Split(key, "#")
        i = i + 1
        For j = 0 To UBound(tmp)
            result(i, j) = tmp(j)
        Next j
    Next key

    With ThisWorkbook.Sheets("Differences")
        .Cells.Clear
        .Range("A1").Resize(UBound(result, 1), UBound(result, 2) + 1) = result
    End With

    Set different_Dico = New Dictionary
    For Each key In data2_Dico.Keys
        If Not data1_Dico.Exists(key) Then
            different_Dico.Add key, key
        End If
    Next key

    ReDim result(1 To different_Dico.Count, 0 To 5)
    i = 0
    For Each key In different_Dico.Keys
        tmp = Split(key, "#")
        i = i + 1
        For j = 0 To UBound(tmp)
            result(i, j) = tmp(j)
        Next j
    Next key

    With ThisWorkbook.Sheets("Differences")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A" & lastRow + 2).Resize(UBound(result, 1), UBound(result, 2) + 1) = result
    End With

    ThisWorkbook.Sheets("Differences").Activate

End Sub

Function Get_Header_Dico(ByVal header As Variant, _
                         ByVal header_line As Long) As Dictionary

    Dim i               As Long
    Dim headerDict      As Dictionary

    Set headerDict = New Dictionary

    For i = LBound(header, 2) To UBound(header, 2)
        If Not headerDict.Exists(header(header_line, i)) Then
            headerDict.Add header(header_line, i), i
        Else
            MsgBox "Please check data header, there is a duplicate"
            End
        End If
    Next i

    Set Get_Header_Dico = headerDict

End Function
Le 30/03/2016 à 14:34

Hello shinpencil et bienvenue sur le forum,

Concernant ton problème, il n'est pas possible de redimensionner la première dimension d'un tableau (dans le cas d'un tableau à plusieurs dimensions)

Si ton tableau est à X dimensions (X = 2 dans ton cas), tu ne peux QUE redimensionner la Xème dimension (ce qui ne t'intéresse pas)

La solution est d'utiliser la transposition de tableau. Une solution est donnée ci-dessous avec une variable temporaire.

L'astuce consiste à

  • Transposer le tableau que l'on souhaite redimensionner. Après transposition, toutes les dimensions sont inversées (la première dimension devient la dernière dimension, la seconde dimension devient l'avant dernière dimension etc...)
  • Redimensionner le tableau temporaire, en modifiant sa deuxième dimension (qui correspond à la première dimension du tableau non transposé)
  • Tranposer ce tableau temporaire pour récupérer notre tableau initial.
Sub solution()
Dim unTableau() As Variant
Dim tableauTemp() As Variant

ReDim unTableau(1 To 1, 1 To 5)
tableauTemp = WorksheetFunction.Transpose(unTableau)
ReDim Preserve tableauTemp(1 To 5, 1 To 10)
unTableau = WorksheetFunction.Transpose(tableauTemp)

End Sub
Le 30/03/2016 à 15:29

Merci de ta réponse.

Comment insérer ce code dans le macro?

Le 30/03/2016 à 16:02
ReDim result(1 To different_Dico.Count, 0 To 5)

à remplacer par

result = WorksheetFunction.Transpose(result)
ReDim Preserve result(0 To 5, 1 To different_Dico.Count)
result = WorksheetFunction.Transpose(result)
Le 04/04/2016 à 15:51

Merci de ta réponse, pourtant j'ai un autre probleme: je dois compare 2 fichiers excel le premier est un fichier csv et le 2eme est un fichier xls. Certaines colonnes dans ces 2 fichiers ne ne sont pas en meme format (Date, Transaction type, Investment type). Le code ne marche pas et le fichier csv est converti en format texte! Que dois je faire?

Option Explicit

Sub Find_Differents()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim data1, data2
    Dim header As Dictionary, data1_Dico As Dictionary, data2_Dico As Dictionary
    Dim different_Dico As Dictionary
    Dim key, tmp, result
    Dim transaction_Type As String, ISIN As String, NAV_Date As String, value_Date As String, nature As String, amount As String
    Dim i As Long, j As Long, lastRow As Long

    With ThisWorkbook.Sheets("Board")
        Set wb1 = Workbooks.Open(.Range("file_name_1"))
        data1 = ActiveSheet.Range("A1").CurrentRegion.Value
'        wb1.Close SaveChanges:=False
        Set wb2 = Workbooks.Open(.Range("file_name_2"))
        data2 = ActiveSheet.Range("A1").CurrentRegion.Value
'        wb2.Close SaveChanges:=False
    End With

    Set header = Get_Header_Dico(data1, 1)

    Set data1_Dico = New Dictionary
    For i = 2 To UBound(data1, 1)
        transaction_Type = data1(i, header("Transaction Type"), "SUB", "RED", "SWI")
        ISIN = data1(i, header("ISIN Code"))
        NAV_Date = Format(data1(i, header("NAV Date")), "yyyymmdd")
        value_Date = Format(data1(i, header("Value Date")), "yyyymmdd")
        nature = data1(i, header("Investment Type"), "M", "P")
        If nature = "Unit" Then
            amount = Format(data1(i, header("Share Nb.")), "#0.0000")
        ElseIf nature = "Amount" Then
            amount = Format(data1(i, header("Fund Amount (Client Cur.)")), "#0.0000")
        End If

        key = transaction_Type & "#" & ISIN & "#" & NAV_Date & "#" & value_Date & "#" & nature & "#" & amount
        If Not data1_Dico.Exists(key) Then
            data1_Dico.Add key, i
        End If
    Next i

    Set header = Get_Header_Dico(data2, 1)

    Set data2_Dico = New Dictionary
    For i = 2 To UBound(data2, 1)
        transaction_Type = data2(i, header("S/R type"), "Subscription", "Redemption", "Switch")
        ISIN = data2(i, header("Fund share code"))
        NAV_Date = Format(data2(i, header("Pricing Date")), "dd/mm/yyyy")
        value_Date = Format(data2(i, header("Value Date")), "dd/mm/yyyy")
        nature = data2(i, header("Nature"), "Amount", "Unit")
        If nature = "Unit" Then
            amount = Format(data2(i, header("Quantity")), "#0.0000")
        ElseIf nature = "Amount" Then
            amount = Format(data2(i, header("Net amount")), "#0.0000")
        End If

        key = transaction_Type & "#" & ISIN & "#" & NAV_Date & "#" & value_Date & "#" & nature & "#" & amount
        If Not data2_Dico.Exists(key) Then
            data2_Dico.Add key, i
        End If
    Next i

    With ThisWorkbook.Sheets("Differences")
        .Cells.Clear
    End With

    Set different_Dico = New Dictionary
    For Each key In data1_Dico.Keys
        If Not data2_Dico.Exists(key) Then
            different_Dico.Add key, key
        End If
    Next key

    If different_Dico.Count > 0 Then
        ReDim result(1 To different_Dico.Count, 0 To 5)
        i = 0
        For Each key In different_Dico.Keys
            tmp = Split(key, "#")
            i = i + 1
            For j = 0 To UBound(tmp)
                result(i, j) = tmp(j)
            Next j
        Next key

        With ThisWorkbook.Sheets("Differences")
            If .Range("A1") <> vbNullString Then
                .Range("A1").Resize(UBound(result, 1), UBound(result, 2) + 1) = result
            Else
                lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                .Range("A" & lastRow + 2).Resize(UBound(result, 1), UBound(result, 2) + 1) = result
            End If
        End With
    End If

    Set different_Dico = New Dictionary
    For Each key In data2_Dico.Keys
        If Not data1_Dico.Exists(key) Then
            different_Dico.Add key, key
        End If
    Next key

    If different_Dico.Count > 0 Then
        ReDim result(1 To different_Dico.Count, 0 To 5)
        i = 0
        For Each key In different_Dico.Keys
            tmp = Split(key, "#")
            i = i + 1
            For j = 0 To UBound(tmp)
                result(i, j) = tmp(j)
            Next j
        Next key

        With ThisWorkbook.Sheets("Differences")
            If .Range("A1") <> vbNullString Then
                .Range("A1").Resize(UBound(result, 1), UBound(result, 2) + 1) = result
            Else
                lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                .Range("A" & lastRow + 2).Resize(UBound(result, 1), UBound(result, 2) + 1) = result
            End If
        End With

    End If

    ThisWorkbook.Sheets("Differences").Activate

   End Sub

Function Get_Header_Dico(ByVal header As Variant, _
                         ByVal header_line As Long) As Dictionary

    Dim i               As Long
    Dim headerDict      As Dictionary

    Set headerDict = New Dictionary

    For i = LBound(header, 2) To UBound(header, 2)
        If Not headerDict.Exists(header(header_line, i)) Then
            headerDict.Add header(header_line, i), i
        Else
            MsgBox "Please check data header, there is a duplicate"
            End
        End If
    Next i

    Set Get_Header_Dico = headerDict

End Function
Rechercher des sujets similaires à "macro comparer workbook erreur"