Oprettet man. d. 26. juli 2010 kl. 22:07:54

hubertus
hubertus (6.720 point. Point ude: 210)

Sammenlign to kolonner og sæt identiske kontonumre overfor hinanden.

Hejsa
Jeg har to kolonner (A og B) med kontonumre. Der er mange sammenfald i de to kolonner. Jeg ønsker at få identiske ordrenumre til at stå ud for hinanden. De skal ske ved at indsætte blanke felter i de to kolonner.

eks.
100132    100132
100133    100133
100138   
100140    100140
100141    100141
100143    100143
100150   
100153    100153
100155    100155
100160    100160
100174    100174
    370177
100180    100180
100183    100183

De unikke kontonumre skal efterfølgende listes i kolonne D og E

Løsningen skal være via VBA kode.


Er der et klogt hoved der kan knække denne nød?

Skrevet man. d. 26. juli 2010 kl. 22:09:02| #1

hubertus
hubertus (6.720 point)
370177 skal selvfølgelig være 100177

Skrevet tir. d. 27. juli 2010 kl. 23:27:20| #2

kabbak
kabbak (151.379 point)
www.kabbak.dk
Prøv at se om det er noget i den retning

Sub Makro1()
    Dim Data As Variant, RW(2) As Long, I As Long, N As Long, OK As Boolean, X As Long
    RW(1) = Range("A65536").End(xlUp).Row + 1
    RW(2) = Range("B65536").End(xlUp).Row + 1
    Data = Range("A:B")

    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal
    Columns("B:B").Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal




    For I = 1 To UBound(Data)
        OK = False
        If IsEmpty(Data(I, 1)) Then Exit For

        For N = 1 To UBound(Data)

            If Data(I, 1) = Data(N, 2) Then
                If I <> N Then

                    For X = I To UBound(Data)
                        If IsEmpty(Data(X, 2)) Then
                            Data(X, 2) = Data(I, 2)
                            Exit For
                        End If
                    Next
                   
                    Data(I, 2) = Data(N, 2)
                    Data(N, 2) = Empty
                    RW(2) = RW(2) + 1
                End If

                OK = True
                Exit For
            End If

        Next

        If Not OK Then

            For X = I To UBound(Data)
                If IsEmpty(Data(X, 2)) Then
                    Data(X, 2) = Data(I, 2)
                    Data(I, 2) = Empty
                    Exit For
                End If
            Next

        End If
    Next

    Range("A1").Activate
    Range("D:E") = Data
End Sub

Skrevet ons. d. 28. juli 2010 kl. 08:18:10| #3

hubertus
hubertus (6.720 point)
Hej Kabbak
Det ser godt ud, men der mangler lidt. Første del med at indsætte blanktegn virker helt perfekt, og listen med kontonumre i kolonne B, som ikke er i A er også, som jeg gerne vil have den. Jeg mangler bare at få listet de kontonumre i kolonne A, som ikke er i B.
Kan du knække den sidste del?

Skrevet ons. d. 28. juli 2010 kl. 10:28:23| #4

hubertus
hubertus (6.720 point)
Kan listen af kontonumre i B, som ikke er i A, isoleres i et range, som jeg kan arbejde videre med? tilsvarende med numrene i A.

Skrevet ons. d. 28. juli 2010 kl. 20:41:00| #5

kabbak
kabbak (151.379 point)
www.kabbak.dk
Sub Makro1()
    Dim Data As Variant, RW(2) As Long, I As Long, N As Long, OK As Boolean, X As Long, Data1 As Variant
    RW(1) = Range("A65536").End(xlUp).Row + 1
    RW(2) = Range("B65536").End(xlUp).Row + 1
    Data = Range("A:B")
    Data1 = Range("G:H")

    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal
    Columns("B:B").Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal




    For I = 1 To UBound(Data)
        OK = False
        If IsEmpty(Data(I, 1)) Then Exit For

        For N = 1 To UBound(Data)

            If Data(I, 1) = Data(N, 2) Then
                If I <> N Then

                    For X = I To UBound(Data)
                        If IsEmpty(Data(X, 2)) Then
                            Data(X, 2) = Data(I, 2)
                            Exit For
                        End If
                    Next

                    Data(I, 2) = Data(N, 2)
                    Data(N, 2) = Empty
                    RW(2) = RW(2) + 1
                End If

                OK = True
                Exit For
            End If

        Next

        If Not OK Then

            For X = I To UBound(Data)
                If IsEmpty(Data(X, 2)) Then
                    Data(X, 2) = Data(I, 2)
                    Data(I, 2) = Empty
                    Exit For
                End If
            Next

        End If
    Next
    X = 1
   
    For I = 1 To UBound(Data)
        If IsEmpty(Data(I, 1)) And Not IsEmpty(Data(I, 2)) Then
            Data1(X, 2) = Data(I, 2)
            X = X + 1
        End If
        If Not IsEmpty(Data(I, 1)) And IsEmpty(Data(I, 2)) Then
            Data1(X, 1) = Data(I, 1)
            X = X + 1
        End If
    Next


    Range("A1").Activate
    Range("D:E") = Data
    Range("G:H") = Data1
End Sub

Skrevet tor. d. 29. juli 2010 kl. 08:41:03| #6

hubertus
hubertus (6.720 point)
Super så er data på plads ;0). Mangler nu kun at kunne bearbejde Data1.
Hvis jeg ønsker selv at kunne styre hvor Data1 skal udskrives, hvordan får jeg så fundet antal elementer i det range som Data1 udgør. Jeg har brug for en for / next løkke, hvori jeg f.eks. kan styre placeringen af udskriften.

Skrevet tor. d. 29. juli 2010 kl. 23:26:52| #7

kabbak
kabbak (151.379 point)
www.kabbak.dk
Husk Option Base 1, uden for kode

Option Explicit
Option Base 1

Sub Makro1()
    Dim Data As Variant, RW(2) As Long, I As Long, N As Long, OK As Boolean, X As Long, Data1 As Variant
    Dim NoMatch() As Variant
    RW(1) = Range("A65536").End(xlUp).Row + 1
    RW(2) = Range("B65536").End(xlUp).Row + 1
    Data = Range("A:B")
    Data1 = Range("G:H")

    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal
    Columns("B:B").Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal




    For I = 1 To UBound(Data)
        OK = False
        If IsEmpty(Data(I, 1)) Then Exit For

        For N = 1 To UBound(Data)

            If Data(I, 1) = Data(N, 2) Then
                If I <> N Then

                    For X = I To UBound(Data)
                        If IsEmpty(Data(X, 2)) Then
                            Data(X, 2) = Data(I, 2)
                            Exit For
                        End If
                    Next

                    Data(I, 2) = Data(N, 2)
                    Data(N, 2) = Empty
                    RW(2) = RW(2) + 1
                End If

                OK = True
                Exit For
            End If

        Next

        If Not OK Then

            For X = I To UBound(Data)
                If IsEmpty(Data(X, 2)) Then
                    Data(X, 2) = Data(I, 2)
                    Data(I, 2) = Empty
                    Exit For
                End If
            Next

        End If
    Next
    X = 1

    For I = 1 To UBound(Data)
        If IsEmpty(Data(I, 1)) And Not IsEmpty(Data(I, 2)) Then
            Data1(X, 2) = Data(I, 2)
            X = X + 1
        End If
        If Not IsEmpty(Data(I, 1)) And IsEmpty(Data(I, 2)) Then
            Data1(X, 1) = Data(I, 1)
            X = X + 1
        End If
    Next
    X = X - 1
   
    ' sætter de overskydende ind i NoMatch variablen
    ReDim NoMatch(X, 2)
    For I = 1 To X
        NoMatch(I, 1) = Data1(I, 1)
        NoMatch(I, 2) = Data1(I, 2)
    Next

    Data1 = Empty ' tømmer data1 fra hukommelsen

    Range("A1").Activate
    Range("D:E") = Data
    Range("H5").Resize(UBound(NoMatch, 1), UBound(NoMatch, 2)) = NoMatch
End Sub

Skrevet lør. d. 31. juli 2010 kl. 08:25:28| #8

hubertus
hubertus (6.720 point)
Super - det var afgrænsning af datasættet Data1 jeg manglede. Opgaven løst, så mangler jeg bare, at du lægger et svar.
Tak for hjælpen og rigtig god weekend :0))

Skrevet lør. d. 31. juli 2010 kl. 08:48:12| #9

hubertus
hubertus (6.720 point)
Sætter lige lidt flere point på højkant.

Deles data1 i henholdsvis NoMatchA og NoMatchB, således at jeg har kolonne D i et range og Kolonne E i et andet. Hvordan får jeg så fjernet de tomme datasæt?

ReDim NoMatchA(X)
    ReDim NoMatchB(X)
   
    For I = 1 To X
        NoMatchA(I) = Data1(I, 1)
        NoMatchB(I) = Data1(I, 2)
    Next

Skrevet søn. d. 01. august 2010 kl. 19:20:16| #10


Skrevet man. d. 02. august 2010 kl. 15:53:59| #11

hubertus
hubertus (6.720 point)
Havde du mod på tillægsspørgsmålet?

Skriv et indlæg




Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] [img]link til billede[/img]
Web- og emailadresser omdannes automatisk til links

Log ind

   

   

Seneste spørgsmål

Svar til: X i en celle giver et andet resultat i anden...

Oprettet den 11. februar 2012 kl. 14.15
ashurra giver 100 point for svar | Giv et svar »

Hjælp til formel rente/antal dage

Oprettet den 11. februar 2012 kl. 12.14
petert giver 30 point for svar | Giv et svar »

Problemløser, "HVIS" formel, eller andet til optimering?

Oprettet den 11. februar 2012 kl. 02.36
Olav123 giver 150 point for svar | Giv et svar »

Seneste guides

Installer win 7
Den gode bruger


   




Tips & Tricks fra PC World

Teaser billede

Her er fem sjove danske websider du skal kende

Trænger dine lattermuskler til en omgang fitness på dansk? Vi viser vej til fem websider fyldt med humor og vanvittig satire.


Anmeldelser fra PC World

Teaser billede

Test: Denne super-tablet er iPads hårdeste konkurrent

Eee Pad Transformer Prime er frygtindgydende med sin quadcore processor og evne til at trylle sig om til bærbar. Apple bør kigge i bagspejlet, for Asus' tablet-pc kommer buldrende - og gør det...


Seneste blogindlæg

Teaser billede

Tvangslukke spørgsmål: Hvad er den bedste løsning?

Hej Vi har mange åbne spørgsmål på Eksperten. Vi ville gerne tvangslukke dem - så et spørgsmål efter f.eks. 6 måneder lukkes. Men der er et par uklarheder som ville være gode at få lidt input til:...


Nyheder fra PC World

Teaser billede

Nu kan du snart hente Windows 8

Den nye offentlige betaversion af Windows 8 er klar i denne måned.


Nyheder fra Computerworld

Teaser billede

Måske snart slut med Androids helt store problem

Android-platformen har længe været plaget af et særligt problem. Men måske er problemet nu ved at være elimineret.


Kurser
Samarbejdspartnere

Udgiver · © 2012 IDG Danmark A/S · Hørkær 18 · 2730 Herlev · Tlf.: 77 300 300 · Fax: 77 300 301 · Brug af personoplysninger