Avatar billede scharff Juniormester
01. september 2006 - 10:36 Der er 92 kommentarer og
1 løsning

Søge og kopiere fra et faneblad til et andet

Hej !
Jeg har et regneark hvor jeg jeg gerne vil søge efter et nummer i en celle hvor der også er tekst i samme, og derefter skal den kopier alle celler hvor det nummer indgår til en anden fane?

eks.
nummer+tekst ligger i faneblad Tal og i celle a2 til a6000
så skulle den gerne ved marco kopiere alle de med det samme nummer som jeg intaster i faneblad 204 a1 (eller i en pop op box)ind i faneblad 204 a2 og frem, så mange der nu er !

Håber der er en der kan hjælpe
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 11:18 #1
Den må du lige forklare lidt nærmere. Står nummeret først, tilfældigt midt i eller i slutningen af cellen? Vil du have kopieret cellen eller værdien. Hvordan vil du angive hvad du søger efter: i en celle eller i en tekstbox?
Avatar billede scharff Juniormester
01. september 2006 - 11:42 #2
nummeret står altid først og gerne i en text box
Avatar billede scharff Juniormester
01. september 2006 - 11:46 #3
nummeret i faneblad Tal står altid først og gerne i en text box
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 11:57 #4
Denne skulle virke:

Private Sub CommandButton1_Click()
zz = Range("A2:A6000")
L = UBound(zz)
step = 1
Range("A2").Select
    t = "1"
For I = 1 To L
    If Left(zz(I, 1), 1) = t Then
        step = step + 1
        Sheets("204").Select
        Range("A" & step).Select
        ActiveCell.Value = zz(I, 1)
        Sheets("Tal").Select
    End If
Next
End Sub

Kan optimeres hvis den tager lang tid!
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 12:07 #5
Det var da noget sludder jeg fik lagt ind:

Private Sub CommandButton1_Click()
Sheets("Tal").Select
zz = Range("A2:A6000")
L = UBound(zz)
step = 1
t = "1"
R = Len(t)
Sheets("204").Select
For I = 1 To L
    If Left(zz(I, 1), R) = t Then
        step = step + 1
        Range("A" & step).Select
        ActiveCell.Value = zz(I, 1)
    End If
Next
End Sub
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 12:32 #6
Med inputbox:

Private Sub CommandButton1_Click()

Dim step As Long

Sheets("Tal").Select



  Dim a As Long, response As Long

  t = Application.InputBox( _

      Prompt:="Skriv tallet du søger", _

      Title:="Find nummeret du skriver:", Type:=2)

  If t <> False Then



zz = Range("A2:A6000")

L = UBound(zz)

R = Len(t)

Sheets("204").Select

For I = 1 To L

    If Left(zz(I, 1), R) = t Then

        step = step + 1

        Sheets("204").Range("A" & step).Select

        ActiveCell.Value = zz(I, 1)

    End If

Next

  End If



End Sub
Avatar billede scharff Juniormester
01. september 2006 - 12:38 #7
ok men hvor skal jeg lægge det hen ?
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 12:57 #8
Jeg regner med at du vil have det aktiveret med en knap.
Højreklik på værktøjslinien, øverst i Excel og sæt flueben ud for "kontrolelementer"... eller gå til "Vis" -> "Værktøjslinier" -> "kontrolelementer".

Du får nu en værktøjslinie frem. Klik på en kommandoknap og klik der på arket hvor du vil have knappen. Dobbeltklik på knappen. Du kommer nu ind i Visual basic hvor der vil stå:

Private Sub CommandButton1_Click()

End Sub

Kopier ovenstående tekst, på nær øverste og nederste linie (de er en gentagelse), så der i alt står:

Private Sub CommandButton1_Click()
Dim step As Long

Sheets("Tal").Select
  Dim a As Long, response As Long
  t = Application.InputBox( _
      Prompt:="Skriv tallet du søger", _
      Title:="Find nummeret du skriver:", Type:=2)
  If t <> False Then

zz = Range("A2:A6000")
L = UBound(zz)
R = Len(t)
Sheets("204").Select
For I = 1 To L
    If Left(zz(I, 1), R) = t Then
        step = step + 1
        Sheets("204").Range("A" & step).Select
        ActiveCell.Value = zz(I, 1)
    End If
Next
  End If
End Sub


Gå tilbage til regnearket, og klik på ikonet med en linial, trekant, og blyant, så denne ikke længere er fremhævet (den findes på værktøjslinien "kontrolelementer")
Avatar billede scharff Juniormester
01. september 2006 - 12:59 #9
Jeg kunne godt tænke mig at der var en knap man trykkede på i faneblad 204 så inputboxen kommer og man kan intaste det man søger efter
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 13:06 #10
Det er det du har i ovenstående!
Avatar billede scharff Juniormester
01. september 2006 - 13:09 #11
ok så er det klaret, men den kopier ikke noget til faneblad 204 når jeg skriver det nummer der svarer til nummer i faneblad Tal A rækken
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 13:11 #12
Hvis du skriver

1aaa
2bbb
1ccc
3ddd
1eee

.. i celle A2:A6, trykker på knappen og skriver et 1-tal?
Avatar billede scharff Juniormester
01. september 2006 - 13:13 #13
så sker der ikke noget ?
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 13:18 #14
Du har vel ikke deaktiveret makroer. har du en hotmail, så kan jeg sende dig et ark?
Avatar billede scharff Juniormester
01. september 2006 - 13:18 #15
Sorry det virker hvis jeg laver knappen i Faneblad Tal ! men ville godt have knappen i Faneblad 204, kan man det ?
Avatar billede scharff Juniormester
01. september 2006 - 13:30 #16
Det kan godt være jeg vil have række B med fra Faneblad Tal sammen med række A ?
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 13:36 #17
Ja, da. Du laver bare en tilsvarende knap i det nye ark.

Her er en lidt mere optimeret kode:

Private Sub CommandButton1_Click()
Dim step As Long
Dim a As Long, response As Long
t = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)
If t <> False And IsNumeric(t) Then

zz = Sheets("Tal").Range("A2:A6000")
L = UBound(zz)
R = Len(t)

For I = 1 To L
    If Left(zz(I, 1), R) = t And Not IsNumeric(Mid(zz(I, 1), R + 1, 1)) Then
        step = step + 1
        Sheets("204").Range("A" & step).Select
        ActiveCell.Value = zz(I, 1)
    End If
Next
 
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If

End Sub
Avatar billede scharff Juniormester
01. september 2006 - 13:36 #18
Jeg ved godt jeg er lidt besværlig men kan det også lade sig gøre at den skriver ind i Faneblad 204 fra A2 og ikke fra A1, der har jeg en overskrift ?
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 13:39 #19
Ovenstående var svar på Kommentar: scharff
01/09-2006 13:18:40

Det kan godt laves så kolonne B kommer med!
Avatar billede scharff Juniormester
01. september 2006 - 13:41 #20
det virker bare fjong ! men så var der lige det med række 2 og at den ikke skriver i A1
Avatar billede scharff Juniormester
01. september 2006 - 13:42 #21
Ups Række B ikke 2
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 13:56 #22
Private Sub CommandButton1_Click()
Dim step As Long
Dim a As Long
t = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)
If t <> False And IsNumeric(t) Then

step = 1
zz = Sheets("Tal").Range("A2:B6000")
L = UBound(zz)
Q = 2 'LBound(zz)
R = Len(t)
    For S = 1 To Q
        For I = 1 To L
            If Left(zz(I, S), R) = t And Not IsNumeric(Mid(zz(I, S), R + 1, 1)) Then
                step = step + 1
                Sheets("204").Range("A" & step).Select
                ActiveCell.Value = zz(I, S)
            End If
        Next
  Next
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If

End Sub
Avatar billede scharff Juniormester
01. september 2006 - 14:32 #23
den kopier ikke række B med over sammen med Række A ? jeg får en fejl der hedder Runtime Error '9'
Subscript out of range
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 14:44 #24
Det lyder som om du er stødt på en grænse. Prøv at trykke "Debug" næste gang, og se hvor i koden du ender.
Avatar billede scharff Juniormester
01. september 2006 - 14:58 #25
Hmm det var måske fordi jeg havde rettet zz = Sheets("Tal").Range("A2:B6000")til L2:L6000 for det var ikke A2 i faneblad Tal men L2 den skulle kikke i og skrive det ind i A2 på faneblad 204 ! er det noget der kan rettes ?

der er også flere kolonner jeg gerne vil have kopieret over sammen med det der står i A eks. kolonne B skal kopieres over i D på faneblad 204 ?
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 15:23 #26
Virker det med A2:B6000?

Skal jg forstå det således at kolonne a-Tal skal til b-204 og b-Tal til c-204. Hvor skal kolonne L fra Tal så? I kolonne M i 204?
Avatar billede scharff Juniormester
01. september 2006 - 15:37 #27
ja det virker med A2:B6000, men ikke at den kopier kolonne b !
nej den skal søge i L2-tal istedet for A2-tal og stadig skrive det ind i A2-204(men det kunne jeg løse ved at flytte data fra L-tal til a-tal.)

jeg mener at c-Tal skal skrives i d-204 ! jeg skal have flere kolonner over i 204 men regner med at det kunne jeg bare selv finde udaf hvis jeg bare har den første.
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 15:53 #28
Prøv denne. Det virker altså ok her. Det eneste du skal ændre er dit range. Der kan stå hvadsomhelst, bare du ikke kommer over kolonne IV:

Private Sub CommandButton1_Click()
Dim step, a, Q, L As Long
Dim MitRange

'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
MitRange = Sheets("Tal").Range("A2:B6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array
RaekkeTal = UBound(MitRange, 2) 'finder bredden på dit array
Application.ScreenUpdating = False 'slår skærmopdatering fra
LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    For s = 1 To RaekkeTal 'tæller hvor mange kolonner der skal gennemløbes
        For I = 1 To KolonneTal
            If Left(MitRange(I, s), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, s), LTal + 1, 1)) Then
                step = step + 1
                IAlt = IAlt + 1
                Sheets("204").Cells(2, 1).Select
                Sheets("204").Cells(step + 1, s).Value = MitRange(I, s)
            End If
        Next
    step = 0
  Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
Range("A1").Select
Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If

End Sub
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 16:03 #29
Prøvede lige med 20.000 tal i 13 kolonner - fra A2 til M20000. Der blev fundet ca. 98.000 værdier på ca. 13 sek.

Du skal lige ændre
Sheets("204").Cells(step + 1, s).Value = MitRange(I, s)
til
Sheets("204").Cells(step + 1, s + 1).Value = MitRange(I, s)
for at rykke en kolonne til højre
Avatar billede scharff Juniormester
01. september 2006 - 16:06 #30
hmm ! den kopier ikke c-Tal over i d-204 sammen med A
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 16:17 #31
Hmmm, nu er jeg slet ikke med??? Skal tallene fra kolonne A og C samlet i kolonne D???

læste du Kommentar: akyhne
01/09-2006 16:03:25?
Avatar billede scharff Juniormester
01. september 2006 - 16:19 #32
det kan godt være det er mig der ikke kan finde udaf at fortælle hvad det er jeg gerne vil have ! men jeg intaster et nummer i tekstboxen og den kikker i a2-tal så skal den kopiere alt med det nummer over i a2-204 og derned af + den også tager det der står i c-tal med over i d-204 og derned af ! var det bedre eller er jeg langt ude og du fatter bjelle :-)
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 16:23 #33
Det jeg har lavet putter
ark "Tal" - kolonne A til ark "204" - kolonne B
ark "Tal" - kolonne B til ark "204" - kolonne C
ark "Tal" - kolonne C til ark "204" - kolonne D
o.s.v.
Avatar billede scharff Juniormester
01. september 2006 - 16:25 #34
hmm der kommer kun noget i a-204 når den finder det rigtige nummer
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 16:33 #35
Altså...
Du klikker på knappen og får en inputbox. Du skriver et nummer, f.eks 77.
Koden løber A2-A6000 igennem for at finde alle celler der starter med 77.
Hver gang den finder et match, kopieres denne celles indhold samt indholdet i celle C til et nyt ark i kolonne D, således at værdien i A og C bindes sammen i celle D.

Du skal kun have løbet kolonne A igennem!
Er dette rigtigt forstået?
Avatar billede scharff Juniormester
01. september 2006 - 16:36 #36
Jeg ved ikke om jeg måtte få dit tlf. nummer på mail så vil jeg gerne ringe til dig, er måske lidt nemmere ! hvis ikke så prøver jeg at skrive her igen ! min mail adresse er scharff_peter@yahoo.dk
Avatar billede scharff Juniormester
01. september 2006 - 16:43 #37
det skal være sådan at jeg klikker på knappen og får en inputbox. jeg skriver et nummer, f.eks 77.
Koden løber A2-A6000 igennem for at finde alle celler der starter med 77.
Hver gang den finder et match, kopieres denne celles indhold samt indholdet i celle C til ark 204 i kolonne D hvor den også skriver i kolonne A
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 16:50 #38
Private Sub CommandButton1_Click()
Dim step, a, Q, L As Long
Dim MitRange


'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
MitRange = Sheets("Tal").Range("A2:C6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array
'RaekkeTal = UBound(MitRange, 2) 'finder bredden på dit array
Application.ScreenUpdating = False 'slår skærmopdatering fra
LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    'For s = 1 To RaekkeTal 'tæller hvor mange kolonner der skal gennemløbes
        For I = 1 To KolonneTal
            If Left(MitRange(I, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, 1), LTal + 1, 1)) Then
                step = step + 1
                IAlt = IAlt + 1
                'Sheets("204").Cells(2, 1).Select
                Sheets("204").Cells(step + 1, 4).Value = MitRange(I, 1) & MitRange(I, 2)
            End If
        Next
    'step = 0
  'Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
Range("A1").Select
Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If

End Sub
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 16:52 #39
Eller sådan:


Private Sub CommandButton1_Click()
Dim step, a, Q, L As Long
Dim MitRange


'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
MitRange = Sheets("Tal").Range("A2:C6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array
'RaekkeTal = UBound(MitRange, 2) 'finder bredden på dit array
Application.ScreenUpdating = False 'slår skærmopdatering fra
LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    'For s = 1 To RaekkeTal 'tæller hvor mange kolonner der skal gennemløbes
        For I = 1 To KolonneTal
            If Left(MitRange(I, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, 1), LTal + 1, 1)) Then
                step = step + 1
                IAlt = IAlt + 1
                'Sheets("204").Cells(2, 1).Select
                Sheets("204").Cells(step + 1, 4).Value = MitRange(I, 1) & MitRange(I, 3)
                Sheets("204").Cells(step + 1, 1).Value = MitRange(I, 1)
            End If
        Next
    'step = 0
  'Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
Range("A1").Select
Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If

End Sub
Avatar billede scharff Juniormester
01. september 2006 - 17:04 #40
nu sker der noget men den skal ikke lægge cellerne sammen
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 17:25 #41
Private Sub CommandButton1_Click()
Dim step, a, Q, L As Long
Dim MitRange


'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
MitRange = Sheets("Tal").Range("A2:E6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array
'RaekkeTal = UBound(MitRange, 2) 'finder bredden på dit array
Application.ScreenUpdating = False 'slår skærmopdatering fra
LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    'For s = 1 To RaekkeTal 'tæller hvor mange kolonner der skal gennemløbes
        For I = 1 To KolonneTal
            If Left(MitRange(I, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, 1), LTal + 1, 1)) Then
                step = step + 1
                IAlt = IAlt + 1
                'Sheets("204").Cells(2, 1).Select
                Sheets("204").Cells(step + 1, 1).Value = MitRange(I, 1)
                Sheets("204").Cells(step + 1, 2).Value = MitRange(I, 2)
                Sheets("204").Cells(step + 1, 3).Value = MitRange(I, 4)
                Sheets("204").Cells(step + 1, 4).Value = MitRange(I, 5)
            End If
        Next
    'step = 0
  'Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
Range("A1").Select
Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If

End Sub
Avatar billede scharff Juniormester
01. september 2006 - 17:58 #42
Ja det er bare kanon det virker sku !! 1000 tak for hjælpen
kan man auto få lavet et faneblad med det nummer man skriver i tekstboxen så den laver det den skal i det nye faneblad den lige har opretet ?
Avatar billede gider_ikke_mere Nybegynder
01. september 2006 - 20:47 #43
Private Sub CommandButton1_Click()
Dim step, a, Q, L As Long
Dim MitRange
Set NewSheet = Worksheets.Add
NewSheet.Range("A1").Value = "Nummer"
NewSheet.Range("B1").Value = "Navn"
NewSheet.Range("C1").Value = "Gade"
NewSheet.Range("D1").Value = "By"

'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
Fejl = 0
For Each ws In Worksheets 'går alle arknavne igennem
If ws.Name = FindTal Or Left(ws.Name, 6 + Len(FindTal)) = (FindTal & " (Kopi") Then 'hvis arknavn findes tælles op
    Fejl = Fejl + 1
End If
Next
If Fejl > 0 Then
    NewSheet.Name = FindTal & " (Kopi" & Fejl & ")"
Else
    NewSheet.Name = FindTal
End If

MitRange = Sheets("Tal").Range("A2:E6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array


Application.ScreenUpdating = False 'slår skærmopdatering fra

LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    'For s = 1 To RaekkeTal 'tæller hvor mange kolonner der skal gennemløbes
        For I = 1 To KolonneTal
            If Left(MitRange(I, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, 1), LTal + 1, 1)) Then
                step = step + 1
                IAlt = IAlt + 1
                NewSheet.Cells(step + 1, 1).Value = MitRange(I, 1)
                NewSheet.Cells(step + 1, 2).Value = MitRange(I, 2)
                NewSheet.Cells(step + 1, 3).Value = MitRange(I, 4)
                NewSheet.Cells(step + 1, 4).Value = MitRange(I, 5)
            End If
        Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
NewSheet.Range("A1").Select

Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If
Sheets("204").Select
End Sub
Avatar billede scharff Juniormester
02. september 2006 - 00:12 #44
det er helt vildt hvor skrap du er til det her det virker bare kanon !!
men så bliver man jo krævene, jeg har et faneblad ny hvor sideopsætningen og alle kolonner og celler er i de rigtige størelser dem ville jeg gerne have overført til det nye nummer ark der bliver lavet ? er jeg for vild nu :-)
Avatar billede gider_ikke_mere Nybegynder
02. september 2006 - 00:38 #45
Hmmm, du trækker kraftigt på de sølle 60 point. Du må give lidt mere ved lejlighed :-) ... og nej, jeg er intet i forhold til de hårde guttere som bak, kabbak, sjap, jkrons, janvogt, flemmingdahl, erikjuul m.m. som har hjulpet mig før, og laver løsninger på 1/20 del af den tid jeg tager om det.

Angående dit spm. Kan du specificere/uddybe lidt mere? Er det cellefarver, kanter (rammer), og cellestørrelser vi snakker om? Er alle celler i kolonne A ens, i kolonne B ens, o.s.v.
Mail evt. et udsnit til mig.
Avatar billede scharff Juniormester
02. september 2006 - 00:46 #46
hele arket skal bare være magen til også sideopsætningen som det faneblad der hedder ny ! den skal vel "bare" kopiere arket ny og så rette det til det nummer der selv kommer.
Avatar billede scharff Juniormester
02. september 2006 - 01:08 #47
Jeg ved ikke om du gider hjælpe mig mere, men der er lidt mere ?
jeg ville godt lave så den soter i celle C2 indtil den møder en tekst inaktiv kunde så skal den lave 5 tomme rækker ovenover og bagefter sortere fra D? hvor teksten inaktiv kunde begynder ?
jeg ved ikke om der skal laves en ny knap eller om du kan putte den ind den anden ?
Avatar billede scharff Juniormester
02. september 2006 - 01:09 #48
du skal nok få mange flere point !
Avatar billede gider_ikke_mere Nybegynder
02. september 2006 - 01:20 #49
Hvis der er mange forskellige formateringer i arket kunne det være en ide, blot at kopiere et standard ark som i forvejen er defineret, men det er nu ikke svært at lave via VBA

Her er hvordan du kopierer et ark kaldet "ny". Det er lavet så dette ark er skjult. Du skal have oprettet dette ark før du kører noget kode, eller i det hele taget lukker Excelfilen. Du kan, hvis du skal redigere i arket, kalde det frem på 2 måder: Luk dit ark på krydset i Excel, og klik "Annuller" - IKKE "nej" ellr "ja"!!! 2. metode er at gå ind i VBA-editoren, markére arket kaldet "ny" i "Projekt-VBAProjekt"-vinduet, kig i vinduet "Properties". Der er et felt der hedder "visible". Klik hvor der står "0 - XLSheetHidden", og sæt den til 1.


Sæt denne kode ind i ThisWorkbook:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("ny").Visible = True
End Sub

Private Sub Workbook_Open()
Sheets("ny").Visible = False
ActiveWorkbook.Sheets("Tal").Tab.ColorIndex = 43
ActiveWorkbook.Sheets("204").Tab.ColorIndex = 43
ActiveWorkbook.Sheets("ny").Tab.ColorIndex = 3
End Sub


Den nye kode til din CommandButton ser således ud:

Private Sub CommandButton1_Click()
Dim step, a, Q, L As Long
Dim MitRange

Sheets("ny").Copy After:=Sheets("204")
Set NewSheet = ActiveSheet
NewSheet.Visible = True
NewSheet.Range("A1").Value = "Nummer"
NewSheet.Range("B1").Value = "Navn"
NewSheet.Range("C1").Value = "Gade"
NewSheet.Range("D1").Value = "By"

'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
Fejl = 0
For Each ws In Worksheets 'går alle arknavne igennem
If ws.Name = FindTal Or Left(ws.Name, 6 + Len(FindTal)) = (FindTal & " (Kopi") Then 'hvis arknavn findes tælles op
    Fejl = Fejl + 1
End If
Next
If Fejl > 0 Then
    NewSheet.Name = FindTal & " (Kopi" & Fejl & ")"
Else
    NewSheet.Name = FindTal
End If

MitRange = Sheets("Tal").Range("A2:E6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array


Application.ScreenUpdating = False 'slår skærmopdatering fra

LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    For I = 1 To KolonneTal
        If Left(MitRange(I, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, 1), LTal + 1, 1)) Then
            step = step + 1
            IAlt = IAlt + 1
            NewSheet.Cells(step + 1, 1).Value = MitRange(I, 1)
            NewSheet.Cells(step + 1, 2).Value = MitRange(I, 2)
            NewSheet.Cells(step + 1, 3).Value = MitRange(I, 4)
            NewSheet.Cells(step + 1, 4).Value = MitRange(I, 5)
        End If
    Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
NewSheet.Range("A1").Select

Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If
Sheets("204").Select
End Sub
Avatar billede gider_ikke_mere Nybegynder
02. september 2006 - 01:27 #50
Kommentar: scharff
02/09-2006 01:08:19

Altså sortere celleområdet A2:D6000 i det nye ark? eller bare løbe kolonne C igennem efter en tekst kaldet "inaktiv" og indsætte 5 tomme rækker over?
Avatar billede gider_ikke_mere Nybegynder
02. september 2006 - 01:49 #51
Sidstnævnte er i hvertfald meget nemt, men jeg stopper for i dag (nat). Konen står snart med kagerullen bag mig ;-)
Avatar billede scharff Juniormester
02. september 2006 - 09:55 #52
den skal først sortere D kolonnen i det nye ark den selv har lavet og så bagefter skal den finde inaktiv kunde og sætte 5 tomme rækker ovenover bagefter skal den så sortere kolonne d igen men kun fra der hvor der starter med inaktiv kunde
Avatar billede scharff Juniormester
02. september 2006 - 10:07 #53
i stedet for den bare selv laver et nyt ark så skal den kopiere arket ny og bruge det.
Avatar billede scharff Juniormester
02. september 2006 - 10:15 #54
det med kopi af faneblad ny virker, så nu er det bare at få den til at sortere :-)
Avatar billede gider_ikke_mere Nybegynder
02. september 2006 - 10:48 #55
Det med sortering må du uddybe. Der kan sorteres på mange måder. Hvis du vil sortere hele området i det nye ark med kolonne D som gældende faktor, indsætter du denne kode:

ActiveCell.SpecialCells(xlLastCell).Select 'Finder nederste celle der er skrevet i
NedersteCelle = ActiveCell.Row

NewSheet.Range("D2:D" & NedersteCelle + 1).Select
Range("A1:D" & NedersteCelle + 1).Sort Key1:=Range("D2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

... imellem disse 2 linier:

NewSheet.Range("A1").Select

Application.ScreenUpdating = True
Avatar billede gider_ikke_mere Nybegynder
02. september 2006 - 10:50 #56
Hvor skal der søges efter inaktiv kunde (kolonne), og hvilken tekst (nøjagtig) skal der søges på?
Avatar billede scharff Juniormester
02. september 2006 - 11:02 #57
min fejl ! der skal kun sortere en gang bagefter skal den finde alle dem hvor der står inaktiv kunde og flytte dem til bunden af arket + 5 tomme rækker ovenover og rykke de andre rækker op til der hvor den har flyttet alle de rækker med inaktiv kunde.
Avatar billede scharff Juniormester
02. september 2006 - 11:03 #58
den skal også søge i kolonne d efter inaktiv kunde
Avatar billede gider_ikke_mere Nybegynder
02. september 2006 - 11:41 #59
Prøv denne. Den søger både i kolonne C og D i dit nye ark efter teksten "inaktiv kunde":

Private Sub CommandButton1_Click()
Dim step, a, Q, L As Long
Dim MitRange

Sheets("ny").Copy After:=Sheets("204")
Set NewSheet = ActiveSheet
NewSheet.Visible = True
NewSheet.Range("A1").Value = "Nummer"
NewSheet.Range("B1").Value = "Navn"
NewSheet.Range("C1").Value = "Gade"
NewSheet.Range("D1").Value = "By"

'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
Fejl = 0
For Each ws In Worksheets 'går alle arknavne igennem
If ws.Name = FindTal Or Left(ws.Name, 6 + Len(FindTal)) = (FindTal & " (Kopi") Then 'hvis arknavn findes tælles op
    Fejl = Fejl + 1
End If
Next
If Fejl > 0 Then
    NewSheet.Name = FindTal & " (Kopi" & Fejl & ")"
Else
    NewSheet.Name = FindTal
End If

MitRange = Sheets("Tal").Range("A2:E6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array


Application.ScreenUpdating = False 'slår skærmopdatering fra

LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    For I = 1 To KolonneTal
        If Left(MitRange(I, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, 1), LTal + 1, 1)) Then
            step = step + 1
            IAlt = IAlt + 1
            NewSheet.Cells(step + 1, 1).Value = MitRange(I, 1)
            NewSheet.Cells(step + 1, 2).Value = MitRange(I, 2)
            NewSheet.Cells(step + 1, 3).Value = MitRange(I, 4)
            NewSheet.Cells(step + 1, 4).Value = MitRange(I, 5)
        End If
    Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
NewSheet.Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select 'Finder nederste celle der er skrevet i
NedersteCelle = ActiveCell.Row

NewSheet.Range("D2:D" & NedersteCelle + 1).Select
Range("A1:D" & NedersteCelle + 1).Sort Key1:=Range("D2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Spring5 = 6
For FindInaktive = 2 To NedersteCelle
    If UCase(NewSheet.Range("D" & FindInaktive).Value) = "INAKTIV KUNDE" Or UCase(NewSheet.Range("C" & FindInaktive).Value) = "INAKTIV KUNDE" Then
        NewSheet.Rows(FindInaktive & ":" & FindInaktive).Select
        Selection.Cut
        NewSheet.Range("A" & NedersteCelle + Spring5).Select
        Selection.Insert Shift:=xlDown
        Spring5 = Spring5 + 5
        FindInaktive = FindInaktive - 1
    End If
Next
Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If
Sheets("204").Select
End Sub
Avatar billede gider_ikke_mere Nybegynder
02. september 2006 - 11:58 #60
Sorry! Sorteringen var gået fløjten :-(


Private Sub CommandButton1_Click()
Dim step, a, Q, L As Long
Dim MitRange

Sheets("ny").Copy After:=Sheets("204")
Set NewSheet = ActiveSheet
NewSheet.Visible = True
NewSheet.Range("A1").Value = "Nummer"
NewSheet.Range("B1").Value = "Navn"
NewSheet.Range("C1").Value = "Gade"
NewSheet.Range("D1").Value = "By"

'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
Fejl = 0
For Each ws In Worksheets 'går alle arknavne igennem
If ws.Name = FindTal Or Left(ws.Name, 6 + Len(FindTal)) = (FindTal & " (Kopi") Then 'hvis arknavn findes tælles op
    Fejl = Fejl + 1
End If
Next
If Fejl > 0 Then
    NewSheet.Name = FindTal & " (Kopi" & Fejl & ")"
Else
    NewSheet.Name = FindTal
End If

MitRange = Sheets("Tal").Range("A2:E6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array


Application.ScreenUpdating = False 'slår skærmopdatering fra

LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    For I = 1 To KolonneTal
        If Left(MitRange(I, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, 1), LTal + 1, 1)) Then
            step = step + 1
            IAlt = IAlt + 1
            NewSheet.Cells(step + 1, 1).Value = MitRange(I, 1)
            NewSheet.Cells(step + 1, 2).Value = MitRange(I, 2)
            NewSheet.Cells(step + 1, 3).Value = MitRange(I, 4)
            NewSheet.Cells(step + 1, 4).Value = MitRange(I, 5)
        End If
    Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
NewSheet.Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select 'Finder nederste celle der er skrevet i
NedersteCelle = ActiveCell.Row

NewSheet.Range("D2:D" & NedersteCelle + 1).Select 'vælger det område der er værdier i
NewSheet.Range("A1:D" & NedersteCelle + 1).Sort Key1:=NewSheet.Range("D2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Spring5 = 6
For FindInaktive = 2 To NedersteCelle
    If UCase(NewSheet.Range("D" & FindInaktive).Value) = "INAKTIV KUNDE" Or UCase(NewSheet.Range("C" & FindInaktive).Value) = "INAKTIV KUNDE" Then
        NewSheet.Rows(FindInaktive & ":" & FindInaktive).Select
        Selection.Cut
        NewSheet.Range("A" & NedersteCelle + Spring5).Select
        Selection.Insert Shift:=xlDown
        Spring5 = Spring5 + 5
        FindInaktive = FindInaktive - 1
    End If
Next
test:
Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If
Sheets("204").Select
End Sub
Avatar billede scharff Juniormester
04. september 2006 - 15:07 #61
Hej igen ! jeg kan ikke få det der til at virke med at når den finder en tekst Med Inaktiv Kunde i Kolonne M (den var d før )så skal den flytte dem ned i bunden og lave 5 tomme rækker over ?
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 15:13 #62
Koden checker i kolonne C og D. Det var det jeg havde forstået!
Du retter bare her:

If UCase(NewSheet.Range("D" & FindInaktive).Value) = "INAKTIV KUNDE" Or UCase(NewSheet.Range("C" & FindInaktive).Value) = "INAKTIV KUNDE" Then

Range("D" og Range("C"
ændres til det det nu skal være.
Range("M"
Avatar billede scharff Juniormester
04. september 2006 - 15:18 #63
det har jeg prøvet men det virker ikke den sorterer fint men den laver ikke noget med at flytte alle dem der står Inaktiv Kunde i ?
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 15:37 #64
Jamen vent lige lidt. Der st[r jo heller ikke noget i kolonne M p[ det ark vi opretter. kun i kolonne A til D!!!
Avatar billede scharff Juniormester
04. september 2006 - 15:40 #65
jeg har udvidet det så der er fra A til N og det med inaktiv Kunde er nu i M
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 15:40 #66
Jamen vent lige lidt. Der står jo heller ikke noget i kolonne M på det ark vi opretter. kun i kolonne A til D!!!
Avatar billede scharff Juniormester
04. september 2006 - 15:41 #67
Sådan ser den ud nu hvis du kan gennemskue det ! det skulle være rigtigt nok tror jeg :-)

Private Sub CommandButton3_Click()
Dim step, a, Q, L As Long
Dim MitRange

Sheets("ny").Copy After:=Sheets("tal")
Set NewSheet = ActiveSheet
NewSheet.Visible = True

'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
Fejl = 0
For Each ws In Worksheets 'går alle arknavne igennem
If ws.Name = FindTal Or Left(ws.Name, 6 + Len(FindTal)) = (FindTal & " (Kopi") Then 'hvis arknavn findes tælles op
    Fejl = Fejl + 1
End If
Next
If Fejl > 0 Then
    NewSheet.Name = FindTal & " (Kopi" & Fejl & ")"
Else
    NewSheet.Name = FindTal
End If

MitRange = Sheets("Tal").Range("A2:p6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array


Application.ScreenUpdating = False 'slår skærmopdatering fra

LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    For I = 1 To KolonneTal
        If Left(MitRange(I, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, 1), LTal + 1, 1)) Then
            step = step + 1
            IAlt = IAlt + 1
            Sheets("Ny").Cells(step + 1, 1).Value = MitRange(I, 1)
                NewSheet.Cells(step + 1, 1).Value = MitRange(I, 1)
                NewSheet.Cells(step + 1, 3).Value = MitRange(I, 14)
                NewSheet.Cells(step + 1, 4).Value = MitRange(I, 3)
                NewSheet.Cells(step + 1, 5).Value = MitRange(I, 4)
                NewSheet.Cells(step + 1, 6).Value = MitRange(I, 5)
                NewSheet.Cells(step + 1, 7).Value = MitRange(I, 6)
                NewSheet.Cells(step + 1, 8).Value = MitRange(I, 7)
                NewSheet.Cells(step + 1, 9).Value = MitRange(I, 8)
                NewSheet.Cells(step + 1, 10).Value = MitRange(I, 9)
                NewSheet.Cells(step + 1, 11).Value = MitRange(I, 10)
                NewSheet.Cells(step + 1, 12).Value = MitRange(I, 11)
                NewSheet.Cells(step + 1, 13).Value = MitRange(I, 12)
                NewSheet.Cells(step + 1, 14).Value = MitRange(I, 16)
           
        End If
    Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
NewSheet.Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select 'Finder nederste celle der er skrevet i
NedersteCelle = ActiveCell.Row

NewSheet.Range("m2:m" & NedersteCelle + 1).Select 'vælger det område der er værdier i
NewSheet.Range("A1:n" & NedersteCelle + 1).Sort Key1:=NewSheet.Range("m2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Spring5 = 6
For FindInaktive = 2 To NedersteCelle
    If UCase(NewSheet.Range("M" & FindInaktive).Value) = "Inaktiv kunde" Or UCase(NewSheet.Range("M" & FindInaktive).Value) = "Inaktiv Kunde" Then
        NewSheet.Rows(FindInaktive & ":" & FindInaktive).Select
        Selection.Cut
        NewSheet.Range("A" & NedersteCelle + Spring5).Select
        Selection.Insert Shift:=xlDown
        Spring5 = Spring5 + 5
        FindInaktive = FindInaktive - 1
    End If
Next
test:
Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If

End Sub
Avatar billede scharff Juniormester
04. september 2006 - 15:45 #68
men den virker stadig ikke med det der Inaktiv Kunde ?
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 16:22 #69
Ret "Inaktiv Kunde" til "INAKTIV KUNDE"!

ucase() sætter teksten til store bogstaver. Det er for at du får resultatet med uanset om du har skrevet

Inaktiv kunde
Inaktiv KUNDE
eller
inaktiv kunde

En ekstra sikkerhed :-)
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 16:32 #70
Der er også en fejl i din sortering:

NewSheet.Range("m2:m" & NedersteCelle + 1).Select 'vælger det område der er værdier i
NewSheet.Range("A1:n" & NedersteCelle + 1).Sort Key1:=NewSheet.Range("m2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

skal være

NewSheet.Range("M2:M" & NedersteCelle + 1).Select 'vælger det område der er værdier i
NewSheet.Range("A2:N" & NedersteCelle + 1).Sort Key1:=NewSheet.Range("M2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Avatar billede scharff Juniormester
04. september 2006 - 17:22 #71
ok så er det rettet men det virker stadig ikke ? efter den har sorteret kolonne M så er den bare markeret ?
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 17:45 #72
Det virker her.
I det ark du har, får du genereret et nyt faneblad. lad os kalde det "1".

I det faneblad er der data i kolonne A-N. I kolonne M er der i nogle celler en tekst der hedder "Inaktiv Kunde".
Korrekt?
Avatar billede scharff Juniormester
04. september 2006 - 17:46 #73
yep
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 17:49 #74
Jeg har sendt et ark på din yahoo mail.
Avatar billede scharff Juniormester
04. september 2006 - 17:59 #75
hmm der ser det ud til at virke men der skal kun være en gang 5 tomme rækker. men hvorfor virker det ikke i mit ark ? Kan det være fordi jeg skjuler kolonne A ?
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 18:15 #76
"Kan det være fordi jeg skjuler kolonne A ?"
Nej, det er Excel ligeglad med.

Prøv med en ny knap med min kode!
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 18:17 #77
Skift

Spring5 = Spring5 + 5

ud med

'Spring5 = Spring5 + 5

...så er der kun 1 gange mellemrum
Avatar billede scharff Juniormester
04. september 2006 - 18:18 #78
har lige sendt dig noget
Avatar billede scharff Juniormester
04. september 2006 - 18:55 #79
har du kikket på det ? virker det ikke mærkeligt at det ikke virker ?
Avatar billede kabbak Professor
04. september 2006 - 19:59 #80
et forslag


Public Sub HentTal()
    Dim RaaData As Variant, R As Long, C As Long, StrTal As String, Res() As Variant, I As Long
    I = 0
    StrTal = InputBox("Indtast søgekreterie")
    RaaData = Sheets("Tal").Range("A2:A6000")
    For R = LBound(RaaData, 1) To UBound(RaaData, 1)
        For C = LBound(RaaData, 2) To UBound(RaaData, 2)
            If Not IsNumeric(RaaData(R, C)) Then
                If InStr(RaaData(R, C), StrTal) Then
                    ReDim Preserve Res(I)
                    Res(I) = RaaData(R, C)
                    I = I + 1
                End If
            End If
        Next
    Next
    Sheets("204").Select
    Sheets("204").Range("A2:A" & UBound(Res) + 2) = Application.WorksheetFunction.Transpose(Res)
End Sub
Avatar billede kabbak Professor
04. september 2006 - 20:27 #81
måske bedre sådan

Public Sub HentTal()
    Dim RaaData As Variant, R As Long, C As Long, StrTal As String, Res As Variant, I As Long
    I = 1
    StrTal = InputBox("Indtast søgekreterie")
    Sheets("204").Range("A2:A6000").ClearContents
    Res = Sheets("204").Range("A2:A6000")
    RaaData = Sheets("Tal").Range("A2:A6000")
    For R = LBound(RaaData, 1) To UBound(RaaData, 1)
        For C = LBound(RaaData, 2) To UBound(RaaData, 2)
            If Not IsNumeric(RaaData(R, C)) Then
                If InStr(RaaData(R, C), StrTal) Then
                    Res(I, 1) = RaaData(R, C)
                    I = I + 1
                End If
            End If
        Next
    Next
    Sheets("204").Select
    Range("A2:A6000") = Res
End Sub
Avatar billede scharff Juniormester
04. september 2006 - 21:18 #82
hmm det andet som akyhne har lavet virker sku lækkert men der er kun lige det sidste (måske :-) ) med de Inaktive kunder som den skal klippes og sættes ned i bunden med 5 tomme rækker ovenover dem .
Avatar billede scharff Juniormester
04. september 2006 - 21:23 #83
det kunne måske være nemmere at den bare kikker kolonne M igennem og når den møder den første række med teksten Inaktive Kunder så sætter den 5 tomme rækker ind ovenover ?
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 21:26 #84
Sorry, var lige til forældremøde. Problemet var at teksten i kolonne M står således "Inaktiv Kunde    " & ikke sådan "Inaktiv Kunde"

Retter nu, samt en anden "fejl"!
Avatar billede scharff Juniormester
04. september 2006 - 21:27 #85
lækkert
Avatar billede scharff Juniormester
04. september 2006 - 23:07 #86
hvis jeg sætter de 4 mellemrum efter INAKTIV KUNDE så går den helt i stå og der sker ikke noget ??
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 23:08 #87
Det skal du heller ikke. fik du min mail?
Avatar billede gider_ikke_mere Nybegynder
04. september 2006 - 23:11 #88
Jeg ved ikke om du får dataene fra en database eller... koden sørger for, kun at læse de første 13 tegn i cellerne i kolonnen "M"

"INAKTIV KUNDE" er 13 tegn incl. mellemrum.
Avatar billede scharff Juniormester
04. september 2006 - 23:11 #89
yep den ser nice ud og ser pt ud som om den virker men kikker på det i morgen foreløbig tak for hjælpen.
Avatar billede scharff Juniormester
05. september 2006 - 07:01 #90
Jeg har lige sendt dig en mail :-)
Avatar billede scharff Juniormester
05. september 2006 - 07:07 #91
den jeg har sendt dig er der måske stadig lidt med sorteringen prøv at kikke i M2 den er ikke rigtig ?
Avatar billede gider_ikke_mere Nybegynder
05. september 2006 - 15:18 #92
Putter lige koden.

Dim MitRange

Sheets("ny").Copy After:=Sheets("tal")
Set NewSheet = ActiveSheet
NewSheet.Visible = True

'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
Fejl = 0
For Each ws In Worksheets 'går alle arknavne igennem
If ws.Name = FindTal Or Left(ws.Name, 6 + Len(FindTal)) = (FindTal & " (Kopi") Then 'hvis arknavn findes tælles op
    Fejl = Fejl + 1
End If
Next
If Fejl > 0 Then
    NewSheet.Name = FindTal & " (Kopi" & Fejl & ")"
Else
    NewSheet.Name = FindTal
End If

MitRange = Sheets("Tal").Range("A2:P6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array


Application.ScreenUpdating = False 'slår skærmopdatering fra

LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    For I = 1 To KolonneTal
        If Left(MitRange(I, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(I, 1), LTal + 1, 1)) Then
            step = step + 1
            IAlt = IAlt + 1
            Sheets("Ny").Cells(step + 1, 1).Value = MitRange(I, 1)
                NewSheet.Cells(step + 1, 1).Value = MitRange(I, 1)
                NewSheet.Cells(step + 1, 3).Value = MitRange(I, 14)
                NewSheet.Cells(step + 1, 4).Value = MitRange(I, 3)
                NewSheet.Cells(step + 1, 5).Value = MitRange(I, 4)
                NewSheet.Cells(step + 1, 6).Value = MitRange(I, 5)
                NewSheet.Cells(step + 1, 7).Value = MitRange(I, 6)
                NewSheet.Cells(step + 1, 8).Value = MitRange(I, 7)
                NewSheet.Cells(step + 1, 9).Value = MitRange(I, 8)
                NewSheet.Cells(step + 1, 10).Value = MitRange(I, 9)
                NewSheet.Cells(step + 1, 11).Value = MitRange(I, 10)
                NewSheet.Cells(step + 1, 12).Value = MitRange(I, 11)
                NewSheet.Cells(step + 1, 13).Value = MitRange(I, 12)
                NewSheet.Cells(step + 1, 14).Value = MitRange(I, 16)
           
        End If
    Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
NewSheet.Range("B1").Select

NewSheet.Range("M1:M" & NedersteCelle + 1).Select 'vælger det område der er værdier i
NewSheet.Range("A1:N" & NedersteCelle + 1).Sort Key1:=NewSheet.Range("M2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

For FindInaktive = 2 To IAlt + 1
    If UCase(Left(NewSheet.Range("M" & FindInaktive - Minus).Value, 13)) = "INAKTIV KUNDE" Then
        NewSheet.Rows(FindInaktive - Minus & ":" & FindInaktive - Minus).Select
        Selection.Cut
        NewSheet.Range("A" & IAlt + 7).Select
        Selection.Insert Shift:=xlDown
        Minus = Minus + 1
    End If
Next
test:
Application.ScreenUpdating = True
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If
Avatar billede scharff Juniormester
05. september 2006 - 15:28 #93
har oprettet et nyt spørgsmål http://www.eksperten.dk/spm/730484 ! der er stadig noget med M2 den er ikke sorteret rigtigt
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
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

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