Macro til dubletter

Skal det være en macro? Kan sikkert laves md alm. formel

ville være rart med en macro jeg kunne fyre af, lige efter jeg havde åbnet dokumentet via en genvejstast, kald mig bare doven :p

Ok, forståeligt nok. Den kan jeg desværre ikke hjælpe dig med, så der må vi have nogle VBA hajer på banen :-)

ok men tak for de hurtige svar ;)

Hvad er konteksten - i regneark, tekstfil eller ? - du nævner "åbnet dokument".

Det er regneark .csv

Spørgsmål:
Er det kun 3. kolonne, der skal anvendes til identifikation af dubletter - eller er det også kolonne 1+2+3?

Det er kun kolonne 3 der skal bruges til at finde dubletten, den symboliserer en vare :)
Tak igen for interessen :)

Ok - så er der et bud her - koden indlægges i en ThisWorkbook i et regneark:
Makroen starter når regnearksfilen åbnes.

Hvis du har brug for mine testfiler - kontakt: pb@supertekst-it.dk

Rem Csv-filen indlæses i Ark1
rem Sortering udføres på kolonne 3
Rem De checkede data lagres på Ark2
Rem Markering (*) i Kolonne 8/Ark2 for dublet-optælling
Rem ===================================================
Dim r1, r2, ident As Double, s1, s2, s3, s4, s5, s6, s7, mark As String
Sub workbook_activate()
Dim række, k1 As Double, k2 As Double, k3 As Double, k4 As Double, k5 As Double, k6 As Double, k7 As Double

    ActiveWorkbook.Sheets("Ark1").Activate
    række = 1
    Open "d:\eksperten\dubletter\tekstdokument.csv" For Input As #1
    While Not EOF(1)
        Input #1, k1, k2, k3, k4, k5, k6, k7
        Cells(række, 1) = k1
        Cells(række, 2) = k2
        Cells(række, 3) = k3
        Cells(række, 3).NumberFormat = "0"

        Cells(række, 4) = k4
        Cells(række, 5) = k5
        Cells(række, 6) = k6
        Cells(række, 7) = k7
        række = række + 1
    Wend
    Close #1
   
    sorter
    checkDubletter række - 1
End Sub
Private Sub sorter()                                        'ifølge kolonne C
    Range("A1").sort Key1:=Range("C1"), Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Sub
Private Sub checkDubletter(antalRækker)
    r2 = 1
    mark = ""
   
    For r1 = 1 To antalRækker
        If r1 = 1 Then
            opsætVærdier
        Else
Rem Optæl hvis ens kolonne 3
            If ident = Cells(r1, 3) Then
                s4 = s4 + Cells(r1, 4)
                s5 = s5 + Cells(r1, 5)
                s6 = s6 + Cells(r1, 6)
                s7 = s7 + Cells(r1, 7)
                mark = "*"
            Else
                overførTilArk2
                opsætVærdier
            End If
        End If
    Next r1
    overførTilArk2
End Sub
Private Sub opsætVærdier()
    ident = Cells(r1, 3)
    s1 = Cells(r1, 1)
    s2 = Cells(r1, 2)
    s3 = Cells(r1, 3)
    s4 = Cells(r1, 4)
    s5 = Cells(r1, 5)
    s6 = Cells(r1, 6)
    s7 = Cells(r1, 7)
End Sub
Private Sub overførTilArk2()
    ActiveWorkbook.Sheets("Ark2").Activate
    Cells(r2, 1) = s1
    Cells(r2, 2) = s2
    Cells(r2, 3) = s3
    Cells(r2, 3).NumberFormat = "0"
    Cells(r2, 4) = s4
    Cells(r2, 5) = s5
    Cells(r2, 6) = s6
    Cells(r2, 7) = s7
    Cells(r2, 8) = mark
    r2 = r2 + 1
    ActiveWorkbook.Sheets("Ark1").Activate
    mark = ""
End Sub

Kanon tester den lige og melder tilbage ;) tak for de hurtige svar :)

Selv tak - her er så et svar

Den er i vinkel, tusind tak for hjælpen ;)