Avatar billede mrkr Juniormester
04. januar 2012 - 15:22 Der er 3 kommentarer og
1 løsning

Finde ens tal og flytte dem

Jeg har et ark med en hulens masse tal i 2 kolonner.
De står i kolonner E og R
Rigtig mange af tallene går igen i de 2 kolonner.
Tallene står sjælendt på samme linje.

De tal som står både i kolonne E og R vil jeg gerne have flyttet til kolonne U og V. istedet, så jeg kan nøjes med at fokusere på de tal der ikke er med i begge kolonner.

Er der nolge der kan løse det problem med lidt vba.

Da det samme tal sagtens kan forekomme mange gange i den samme kolonne skal koden altid kun flytte et par af gangen og så se om der findes et par mangen til nedenfor inden flytter det næste par.
Avatar billede Ialocin Novice
05. januar 2012 - 14:03 #1
Hej mrkr

Kan du evt. bruge følgende VBA kode ?
Koden flytter talpar fra kolonne E og R til kolonne U og V.


Sub FindOgFlytTalpar()
Dim wb As Workbook
Dim ws As Worksheet
Dim eSidsteRække As Integer
Dim rSidsteRække As Integer
Dim uSidsteRække As Integer
Dim eCell As Range
Dim rCell As Range



Application.ScreenUpdating = False


    '** klargør objekter og variabler **
   
    'sæt wb = denne workbook
    Set wb = ThisWorkbook
   
    'sæt ws = arket med navnet "Sheet1"
    Set ws = wb.Worksheets("Sheet1")
     
    'sidste række i kolonne E
    eSidsteRække = ws.Range("E65536").End(xlUp).Row
   
    'sidste række i kolonne R
    rSidsteRække = ws.Range("R65536").End(xlUp).Row

   
        '** Gennemløb af kolonne E og R


        'løb ned gennem hver celle i kolonne E til sidste celle med en værdi
        For Each eCell In ws.Range("E1:E" & eSidsteRække)
                         
                'løb ned gennem hver celle i kolonne R til sidste celle med en værdi
                For Each rCell In ws.Range("R1:R" & rSidsteRække)
               
                                           
                            'hvis den aktive celle i kolonne A er = den aktive celle i kolonne R
                            If eCell.Value = rCell.Value Then
                                                                           
                                'første gang der skrives et talpar
                                If ws.Range("U1").Value = "" Then
                               
                                    'sæt U1 = den aktuelle værdi fra kolonne E
                                    ws.Range("U1").Value = eCell.Value
                                   
                                    'sæt V1 = den aktuelle værdi fra kolonne R
                                    ws.Range("V1").Value = rCell.Value
                                       
                                        'tøm de aktuelle celler i kolonne E og R
                                        eCell.Value = ""
                                        rCell.Value = ""
                                       
                                        'sæt uSidsteRække = sidste celle med en værdi i kolonne U
                                        uSidsteRække = ws.Range("U65536").End(xlUp).Row
                                       
                                        'forlad løkken
                                        Exit For
                                                                           
                                Else
                               
                                       
                                        'sæt cellen under sidste celle med værdi i kolonne U = den aktuelle værdi fra kolonne E
                                        ws.Range("U" & uSidsteRække + 1).Value = eCell.Value
                                       
                                        'sæt cellen under sidste celle med værdi i kolonne V = den aktuelle værdi fra kolonne R
                                        ws.Range("V" & uSidsteRække + 1).Value = rCell.Value
                                       
                                       
                                        'tøm de aktuelle celler i kolonne E og R
                                        eCell.Value = ""
                                        rCell.Value = ""
                                       
                                        'sæt uSidsteRække = sidste celle med en værdi i kolonne U
                                        uSidsteRække = ws.Range("U65536").End(xlUp).Row
                                       
                                        'forlad løkken
                                        Exit For
                                       
                                End If
                                                                     
                            End If
                           
                           
                           
                'næste celle i kolonne R
                Next rCell
 
             
        'næste celle i kolonne E
        Next eCell


Application.ScreenUpdating = True

End Sub



Med venlig hilsen, Nicolai
Avatar billede mrkr Juniormester
06. januar 2012 - 17:41 #2
Sådan der!
Det var lige det jeg havde brug for.
Det vil godt nok spare mig en masse tid.

Mange tak for hjælpen.
Har du et svar så jeg kan afgive points :-)
Avatar billede Ialocin Novice
06. januar 2012 - 20:33 #3
Hej mrkr

Godt at høre det virker efter hensigten :o)
Hermed mit svar.

Med venlig hilsen, Nicolai
Avatar billede Ialocin Novice
07. januar 2012 - 16:54 #4
Hej mrkr

Tak for point.
Du er velkommen til at gi´ lyd, hvis det ikke spiller ?

Med venlig hilsen, Nicolai
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester