Importation CSV et exploitation des données

Bonjour,

Je souhaiterai importer un fichier .csv dans un onglet (Data) à l'aide d'une macro puis, comparer les ID du fichiers .csv avec les ID que j'ai déjà (feuil1).

Le but serait que si la valeur entre l'ID du fichier csv et l'ID, alors je copie le "numéro de flux" associé à l'ID du fichier .csv et le l'associe aux ID que j'avais déjà. (J’espère que ce n'est pas trop confus )

Je me tourne vers vous pour 2 soucis que je rencontre:

• Je ne sais pas pourquoi j'arrive à importer correctement certains fichier Csv et certains non.
• Je ne vois pas du tout comment copier les "numéros de flux" associés aux ID du fichier Csv et les associés aux ID que j'ai sur l'onglet "feuil1"

J'arrive bien à récupérer le fichier .csv dans l'onglet "Data" avec le code suivant :

Sub Import()
     Dim fStr As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Cancel Selected"
            Exit Sub
        End If
        'fStr is the file path and name of the file you selected.
        fStr = .SelectedItems(1)
    End With

Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Data"
Worksheets("Data").Activate
    With ThisWorkbook.Sheets("Data").QueryTables.Add(Connection:= _
    "TEXT;" & fStr, Destination:=Range("$A$1"))
        .Name = "CAPTURE"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Et le code que j'utilise pour comparer et essayer de faire correspondre les numeros de flux est le suivant :

Sub Compare()

Dim Range1 As Range, Range2 As Range, Rng1 As Range, Rng2 As Range, outRng As Range
xTitleId = "KutoolsforExcel"
Set Range1 = Application.Selection
Set Range1 = Application.InputBox("Range1 :", xTitleId, Range1.Address, Type:=8)
Set Range2 = Application.InputBox("Range2:", xTitleId, Type:=8)
Application.ScreenUpdating = False
For Each Rng1 In Range1
    xValue = Rng1.Value
    For Each Rng2 In Range2
        If xValue = Rng2.Value Then
            If outRng Is Nothing Then
                Set outRng = Rng1
            Else
                Set outRng = Application.Union(outRng, Rng1)
            End If
        End If
    Next
Next
outRng.Select 'On colorie en rouge les ID identiques entre le CSV et mes ID
 With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
 End With
Application.ScreenUpdating = True
End Sub

J'arrive a identifier les ID identiques mais je n'ai pas du tout de piste pour copier coller les numéro correspondants aux ID...

J’espère que avoir été assez clair et que vous pourrez m'aider.

Merci d'avance.

Ardoudoux - Etudiant

bonjour,

un proposition pour l'ajout du flux

Sub Compare()

    Dim a, outRng As Range
    xTitleId = "KutoolsforExcel"
    Set ws1 = Sheets("feuil1")
    Set ws2 = Sheets("data")
    dlws1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    dlws2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    Application.ScreenUpdating = False
    a = ws1.Range("A1:A" & dlws1)
    Set pl = ws2.Range("A1:A" & dlws2)
    For i = LBound(a, 1) To UBound(a, 1)
        Set re = pl.Find(a(i, 1), lookat:=xlWhole)
        If Not re Is Nothing Then
            ws1.Cells(i, 2) = re.Offset(, 1).Value
            If outRng Is Nothing Then
                Set outRng1 = ws1.Cells(i, 1)
                Set outRng = re
            Else
                Set outRng = Application.Union(outRng, re)
                Set outRng1 = Application.Union(outRng1, ws1.Cells(i, 1))
            End If
        End If
    Next
    'On colorie en rouge les ID identiques entre le CSV et mes ID
    With outRng.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
        With outRng1.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Application.ScreenUpdating = True
End Sub

Super h2so4 ! Cela fonctionne bien. Merci beaucoup !