Makro og VBA - Beholde Dublikater

Print side | Luk vindue

Beholde Dublikater

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=4152
Udskrevet den: 23.Nov.2024 kl. 03:10

Emne: Beholde Dublikater

Besked fra: Lucky
Emne: Beholde Dublikater
Posteringsdato: 29.Jan.2020 kl. 20:15

Hejsa Forum,

jeg er meget ny herinde, men også i den verden som hedder VBA. Dog må jeg indrømme at det er noget af det fedeste jeg har startet på. :-)

Jeg er ved at lave en lille database til vores forening. Vi kunne godt tænke os at bibeholde alle Dubletterne i et regneark for at se hvor mange af vores medlemmer som deltager på flere hold.

Det er godt nok svært at finde noget kode til det og må også indrømme at jeg ikke er så skarp til liiige at kunne gennem skue dem.

Jeg har vedhæftet et prøveark hvad jeg godt kunne tænke mig. :-)

Jeg vil gerne beholde Dubletterne i arket til beregning. Single værdierne skal jeg ikke bruge.

Derudover så er spørgsmålet om der findes en lettere måde at beregne alderen på kursisterne på som jeg har gjort.

Er det mon muligt med VBA?

Kunne bare være så fed og lette Vores kasserer for meget blyant.

Hilsen

Lucky

uploads/2606/Dummy_sheet.xlsm - uploads/2606/Dummy_sheet.xlsm

Svar:

Besked fra: Mads32
Posteringsdato: 29.Jan.2020 kl. 23:16

Hej

Dine /topic662.html - uploads kan ikke downloades.

For at /topic662.html - uploade en fil, skal du følge vejledningen øverst i venstre hjørne ar skærmen.

Besked fra: Lucky
Posteringsdato: 29.Jan.2020 kl. 23:48

Prøver det lige igen - syntes nu at jeg fulgte vejledningen

Besked fra: Lucky
Posteringsdato: 29.Jan.2020 kl. 23:51

uploads/2606/Dummy_sheet_2020-01-29_23-50-13.xlsm" rel="nofollow - uploads/2606/Dummy_sheet_2020-01-29_23-50-13.xlsm

Besked fra: Mads32
Posteringsdato: 30.Jan.2020 kl. 09:51

Hej

Nu kan den downloades. jeg ser på sagen senere, men nu kan andre også se på den.

Besked fra: Mads32
Posteringsdato: 30.Jan.2020 kl. 10:33

Hej

Jeg har haft åbnet din fil, og kan konstatere at programmet er lavet med nogle flotte makroer.

Vedkommende der har lavet programmet kan sikkert hurtigt lave en tilføjelse som også løser dit spørgsmål.

I den dummyfil du har uploadet har ingen dubletter.

Jeg har i vedhæftede fil vist hvad der manuelt kan gøres for at få et overblik.

Kopierer dit arktil nyt ark

Indsætter en ny kolonne forest, og laver formel der sammensætter for- og efternavn, derved har du et unikt navn.

Sorterer på det nye navn.

hvad der derefter skal ske for at vise dubletter automatisk ved jeg ikke, men med de få medlemmer du har på din dummyliste er det hurtigt overskuet.

Måske kan det inspirere til en makroløsning.

https://www.dropbox.com/s/s2b48bwus2pxlcb/Dummy_sheet_2020-01-29_23-50-13_mads32.xlsm?dl=0" rel="nofollow - https://www.dropbox.com/s/s2b48bwus2pxlcb/Dummy_sheet_2020-01-29_23-50-13_mads32.xlsm?dl=0

Jeg kan ikke hjælpe yderligere, men kan du lige mit indlag så marken med "TAK"

mvh mads32

Besked fra: Lucky
Posteringsdato: 30.Jan.2020 kl. 10:38

Tak

Besked fra: Lucky
Posteringsdato: 30.Jan.2020 kl. 10:50

Hejsa Mads,
den havde jeg ikke lige tænkt på og dog....:-)
Formlen skal gerne sammenlign for og efternavn + fødselsdato, da 2 personer godt kan have samme for og efternavn :-)
Men rigtig mange tak for input og forslag :-)

Besked fra: Lucky
Posteringsdato: 14.Feb.2020 kl. 12:59

Ville lige informere om at løsningen ikke helt svarede til det jeg søgte efter.
Men jeg har fået stykket denne kode sammen - med min beskedne viden som nybegynder i vba.
Syntes dog at jeg ville dele den med jer herinde.
Den funker men kan sikkert forberes. :-) Og skulle der være en som keder sig så er du velkommen. :-)Kunne jo være andre som havde samme udfordring. :-)

Sub BeholdDubletter ()

    Dim lastRow As Integer, compRow As Integer, rowNo As Integer
    Dim wstOutput As Worksheet
    Dim copyrow As Long

    'Finder sidste række med data
    lastRow = ActiveWorkbook.Sheets("Beregning af Alder til Database").Range("A1").CurrentRegion.Rows.count

    'Looper igennem alle rækker

    For rowNo = 2 To lastRow

     Set wks = Worksheets("Data")

        'For each rowNo, looper igennem de sidste rækker

        For compRow = rowNo + 1 To lastRow

            'Checker om der er et match i kolonne A

            If Range("A" & compRow) = Range("A" & rowNo) Then

               'Hvis at der er et match i kolonne A, check den tilsvarende værdi i kolonne B

               If Range("B" & compRow) = Range("B" & rowNo) Then

                    'Hvis at der er et match i kolonne A og B, check den tilsvarende værdi i kolonne C

                    If Range("C" & compRow) = Range("C" & rowNo) Then

                        'Dublikater fundet på tværs af de 3 kolonner. Markeres med gult
                        'Range("A" & compRow & ":D" & compRow).Interior.Color = vbYellow eller
                        'Dublikater fundet på tværs af de 3 kolonner. Kopier række A til D og placer dem i ark "Data
                        Range("A" & compRow & ":D" & compRow).Select
                        copyrow = wks.Cells(Rows.count, "A").End(xlUp).row + 1
                      Range("A" & compRow & ":D" & compRow).Copy _
                     Destination:=wks.Range("A" & copyrow & ":D" & copyrow)

                    End If
               End If
            End If
        Next compRow
    Next rowNo
End sub

Print side | Luk vindue