Finde ens tal i en kolonne og flytte dem til en anden kolonne e

Hej mrkr

Skal lige forstå dig ret.

Hvilket tal er det der skal flyttes over i kolonne N ... er det de positive (+) eller de negative (-) tal ... eller bare selve tallet uden fortegn ?

Og skal tallet der flyttes, starte i række 1 i kolonne N ... og så ellers fortløbende nedad i kolonnen ?


Med venlig hilsen, Nicolai

Det er det tal der står i kolonne M der skal flyttes, uanset om det er + eller -. Så det tal der kommer over i kolonne N skal have det samme fortegn som det altid har haft.

Når alle rækker er løbet igennem skulle der gerne stå en masse tal i kolonne N som samlet set giver 0.

Koden skal nemlig finde par med tal der giver 0. Feks. +100 og -100.

De tal der flyttes skal helst blive i den række de oprindeligt var i. De skal bare flytts fra kolonne M til kolonne N.

Hej mrkr

Jeg er med på, at der skal flyttes tal fra kolonne M til kolonne N.

Så langt, så godt :o)

Du skriver i #1:

"Feks +125,25 og -125,25.
Når parene er fundet skal det flyttes til kolonne N, så der kun står tal i kolonne M, i de rækker der ikke er blevet udlignet."

Mit spørgsmål er så:  Hvilket af de to tal i parret vil du ha´ flyttet over ... det positive eller det nagative ?

Mvh Nicolai

Hej mrkr

Hermed lidt VBA kode ... som jeg umiddelbart forstår det ?
Kopier proceduren ind i Excels VBA editor (alt + F11) og kald den evt. via en knap på det aktuelle ark.

Koden løber ned gennem kolonne M og tjekker for talpar der giver 0.
Begge tallene i de fundne par flyttes til nabocellen (kolonne N) med det fortegn de har.

Hos mig fungerer det i den engelske udgave af Excel 2003.

OBS:
Koden er IKKE sikret mod alt andet end tal i kolonne M!
Området der søges i, i kolonne M går fra celle 1 til første tomme celle = hvis alle tal i kolonne M skal med i søgningen, skal de komme fortløbene uden tomme celler i mellem!

Begge "isues" kan dog løses :o)


Gi´ lyd, hvis "skidtet" ikke virker ?


------------


Sub FindModsatteTal()
Dim myRange As Range        'området der skal tjekkes
Dim rtal As Double          'sammenligningsværdi i den aktuelle celle
Dim counter As Integer      'tæller til løkken
Dim antalrækker As Integer  'antallet af rækker i området
Dim tjekværdi As Boolean    'tjekværdi, som sættes true hvis der er gengangere


'initalisering af tjekværdi
tjekværdi = False


'vælg celle 1 i kolonne M
Sheets(1).Cells(1, 13).Select


'set myRange = området ned til sidste værdi i kolonne med den valgte celle
Set myRange = Selection.CurrentRegion


'tæl antal rækker/celler i området
antalrækker = myRange.Count


'for hver celle i området (kolonne M)
For Each r In myRange
   
   
    'vælg aktuel celle
    r.Cells.Select
   
    'sæt rtal = den aktuelle celleværdi/sammenligningsværdi
    rtal = r.Value
   
   
                'løb ned gennem cellerne til sidste celle med en værdi
                'start i celle 2
                For counter = r.Row + 1 To antalrækker
               
                    'set curcell = den næste celle i kolonnen/området
                    Set curcell = Worksheets("Sheet1").Cells(counter, 13)
                   
                   
                   
                    'hvis værdien i den valgte celle er tom
                    If rtal = 0 Then
           
                        'Ingen sammenligning!
                   
                    Else
                   
           
                            'hvis værdien i curcell + værdien i den aktuelle celle (rtal) = 0
                            If curcell + rtal = 0 Then
               
                                'sæt nabo cellen til højre for curcell = værdien af curcell
                                curcell.Offset(0, 1).Value = curcell
                               
                                'sæt nabo cellen til højre for den aktuelle celle = værdien af rtal
                                r.Offset(0, 1).Value = rtal
                               
                               
                             
                               
                                'tøm curcell for værdi
                                curcell.Value = ""
                               
                                'tøm den aktuelle celle for værdi
                                r.Value = ""
                               
                                'spring videre til næste sammenligningsværdi
                                GoTo line1
               
                            End If
                                   
                                   
                                 
                   
                    End If
                   
                   
                   
                'næste celle
                Next counter

           
   
            'næste sammenligningscelle/værdi
line1:      Next


End Sub


-----------


Med venlig hilsen, Nicolai

Hvis du skulle foretrække en formelløsning (hvor dog tallene i kolonne M bliver stående), så prøv denne matriksformel:

=HVIS(ER.TAL(SAMMENLIGN(SAND;(M1=-($M$1:$M$100));0));M1;"")

Beklager at jeg først vender tilbage nu.
Men jeg har været ude at rejse et par dage.

Jeg har testet koden, men den gør ikke det jeg gerne vil have den til at gøre.

Når koden køres hos mig blinker skærmen, men der er ingen tal der flyttes fra kol M til N.

Den skal flytte par med tal + og - fra kolonne M til N.

Tak for input med formelløsning, men jeg vil helst have en kodeløsning, hvis det kan lade sig gøre

Ialocins kode virker perfekt her.
Hans

Hej Begge

Tak til Hans :o)


Mrkr:
Ved ikke lige, hvordan jeg hjælper dig ?
I min engelsek udgave af Excel 2003 fungerer det også uden problemer.

Hos mig ligger koden bag det aktuelle ark  (Sheet1), hvor jeg har tallene i kolonne M.
På samme ark (Sheet1) har jeg også min knap, som kalder koden.

Hvis du ikke har har tallene på ark1/Sheet1 ???, så er du nødt til at rette lidt i koden, så den passer til dit ark/sheet nummer.

Se nedenstående 2 markeringer:


---------

Sub FindModsatteTal()
Dim myRange As Range        'området der skal tjekkes
Dim rtal As Double          'sammenligningsværdi i den aktuelle celle
Dim counter As Integer      'tæller til løkken
Dim antalrækker As Integer  'antallet af rækker i området
Dim tjekværdi As Boolean    'tjekværdi, som sættes true hvis der er gengangere


'initalisering af tjekværdi
tjekværdi = False


'vælg celle 1 i kolonne M
Sheets(1).Cells(1, 13).Select

'set myRange = området ned til sidste værdi i kolonne med den valgte celle
Set myRange = Selection.CurrentRegion


'tæl antal rækker/celler i området
antalrækker = myRange.Count


'for hver celle i området (kolonne M)
For Each r In myRange
   
   
    'vælg aktuel celle
    r.Cells.Select
   
    'sæt rtal = den aktuelle celleværdi
    rtal = r.Value
   
   
    'løb ned gennem cellerne til sidste celle med en værdi
    'start i celle 2
    For counter = r.Row + 1 To antalrækker
   
        'set curcell = den næste celle i kolonnen/området
        Set curcell = Worksheets("Sheet1").Cells(counter, 13)
       
       
       
        'hvis værdien i den valgte celle er tom
        If rtal = 0 Then

            'Ingen sammenligning!
       
        Else
       
       
'            Select Case tjekværdi
'
'                'hvis der ikke er fundet et modsat tal
'                Case False
       
       
                        'hvis værdien i curcell + værdien i den aktuelle celle (rtal) = 0
                        If curcell + rtal = 0 Then
           
                            'sæt nabo cellen til højre for curcell = værdien af curcell 'sammenligningsværdien
                            curcell.Offset(0, 1).Value = curcell                        'rtal
                           
                            'sæt nabo cellen til højre for den aktuelle celle = værdien af rtal 'sammenligningsværdien
                            r.Offset(0, 1).Value = rtal
                           
                           
                           
'                            'sæt tjekværdi = true
'                            tjekværdi = True
                           
                            'tøm curcell for værdi
                            curcell.Value = ""
                           
                            'tøm den aktuelle celle for værdi
                            r.Value = ""
                           
                            GoTo line1
           
                        End If
                       
                       
                       
                       
                                                 
'                'hvis der allerede er fundet et match
'                Case True
'
'                        'hvis værdien i curcell + værdien i den aktuelle celle (rtal)
'                        If curcell + rtal = 0 Then
'
'
'                            'tøm curcell for værdi
'                            curcell.Value = ""
'
'                        End If
'
'
'                End Select
       
        End If
       
       
       
    'næste celle
    Next counter

   
'        'set tjekværdien = false, så den er klar til næste gennemløb
'        tjekværdi = False
       
   
           
line1:  Next


End Sub



----------

Med venlig hilsen, Nicolai

Så fik jeg endelig tid til at teste igen.
Det virker super her nu.
Det var bare en lille rettelse der skulle til med arknavnet, så kører den lige som jeg efterspurgte.

Mange tak for hjælpen lalocin.

Har du et svar?

Hej mrkr

Bedre sent end aldrig :o)

Godt at høre, at det fungerer.
Du gi´r bare lyd, hvis der er tvivl eller andet ?

Hermed et "svar".

Med venlig hilsen, Nicolai

Will do
Endnu en gang tak for hjælpen

Hej mrkr

Det var så lidt ... og selv tak for point :o)

Med venlig hilsen, Nicolai