Avatar billede scharff Juniormester
05. september 2006 - 14:56 Der er 17 kommentarer og
1 løsning

Søge og kopiere fra et faneblad til et andet + sortering

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 + sortere ? kik her

http://www.eksperten.dk/spm/729728?Esession=3b8a9d329d948486ae339c150cb6ec22
Avatar billede scharff Juniormester
05. september 2006 - 15:10 #1
Det ser ud til at virke som det skal men så er der lige det her ?
hvis jeg så vil have at de rækker der står Markedskunde i bliver flyttet ned efter Inaktive Kunde og Ny Kunde og
Reaktiveret kunde bliver flyttet op efter Aktiv kunde så det ser sådan her ud :

Aktiv Kunde
Ny Kunde
Reaktiveret Kunde





Inaktiv Kunde
Markedskunde


bagefter skal den sortere i kolonne G alle dem der hedder
Aktiv Kunde
Ny Kunde
Reaktiveret Kunde

og derefter sortere kolonne F alle dem der hedder
Aktiv kunde
Ny Kunde
Reaktiveret Kunde

Og derefter sortere i kolonne G alle dem der hedder
Inaktiv Kunde
Markedskunde

Og tilsidst sortere i kolonne F alle dem der hedder
Inaktiv Kunde
Markedskunde.
Avatar billede gider_ikke_mere Nybegynder
05. september 2006 - 16:34 #2
Lige en let én.

Kender du til autofilter? Prøv at markere kolonne "M". Gå op i <Data><Filter><Autofilter>
Du får nu en knap ved celle M1. Prøv at klikke og leg lidt med den!
Avatar billede scharff Juniormester
05. september 2006 - 17:56 #3
Ja det var let men hvorfor vil den have Reaktiveret kunde øverst ?
Avatar billede gider_ikke_mere Nybegynder
05. september 2006 - 18:09 #4
Jeg tror du mener Aktiveret kunde. Den tager det alfabetisk. Filteret sorterer og bytter intet i arket, men skjuler bare de irelevante celler.

Du kan markere A-N kolonnerne og slå autofilter til. Så kan du i M vælge "Inaktiv kunde" - disse bliver vist - andre skjult. Derefter går du til kolonne G og via filteret vælger "sortér stigende", eller hvad du ønsker.

Jeg ved jo ikke hvad formålet med dit ark er, men det er en meget let løsning, hvis du kan nøjes med at få vist en kundegruppe af gangen!
Avatar billede scharff Juniormester
05. september 2006 - 18:21 #5
jeg syntes ikke at det er brug bar til at udskrive listen bagefter der skal det jo stå sådan som den fil jeg sendte dig på mail
Avatar billede scharff Juniormester
05. september 2006 - 18:24 #6
jeg taler om filen jeg sendte til dig der står Reaktiveret kunde øverst i kolonne M i det nye ark når man intaster 204 ?
Avatar billede gider_ikke_mere Nybegynder
06. september 2006 - 06:21 #7
Prøv denne:

Private Sub CommandButton3_Click()
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

Dim RankArray
RankArray = NewSheet.Range("A2:N" & IAlt + 1)
Dim Skift
Dim test As Variant

test = Array("AKTIV KUNDE", "NY KUNDE", "REAKTIVERET KUNDE", "INAKTIV KUNDE", "MARKEDSKUNDE")
ReDim Temp(14)
N = UBound(RankArray)
For XY = 0 To 4
    For i = 1 To N - 1
        For j = i To N
            If UCase(Left(RankArray(i, 13), Len(test(XY)))) = test(XY) Then
                For Skift = 1 To 14
                    Temp(Skift) = RankArray(i, Skift)
                    RankArray(i, Skift) = RankArray(j, Skift)
                    RankArray(j, Skift) = Temp(Skift)
                Next
            End If
        Next
    Next
Next
NewSheet.Range("A2:N" & IAlt + 1) = RankArray

MArray = NewSheet.Range("M2:M" & IAlt + 1)
Dim NotOk
NotOk = 1
Do While NotOk < IAlt + 1
NotOk = NotOk + 1
    If UCase(Left(MArray(NotOk, 1), 13)) = "INAKTIV KUNDE" Then
        Fundet = NotOk + 1
        NotOk = IAlt + 1
    End If
Loop
For RkLoop = 1 To 5
    NewSheet.Rows(Fundet & ":" & Fundet).Select
    Selection.Insert Shift:=xlDown
Next
NewSheet.Range("A1:N" & Fundet - 1).Sort Key1:=NewSheet.Range("G2"), Order1:=xlAscending, Key2:=NewSheet.Range( _
    "F2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
    :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
    DataOption2:=xlSortNormal
NewSheet.Range("A" & Fundet + 5 & ":N" & IAlt + 5).Sort Key1:=NewSheet.Range("G" & Fundet + 5), Order1:=xlAscending, Key2:= _
        NewSheet.Range("F" & Fundet + 5), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
MsgBox "Færdig"
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If
Application.ScreenUpdating = True
End Sub

Den afsluttende sortering er jeg lidt i tvivl om jeg har forstået rigtigt. Men prøv!
Avatar billede scharff Juniormester
06. september 2006 - 08:33 #8
Nu tror jeg sku' den er der, du er bare for hård til det her !
Kan man få den til at kikke efter 204 i Kolonne L i stedet for A ? for så Skal jeg ikke kopiere fra L til A først.
Avatar billede scharff Juniormester
06. september 2006 - 10:57 #9
jeg mener i faneblad Tal
Avatar billede gider_ikke_mere Nybegynder
06. september 2006 - 11:53 #10
Det skulle bare være således:

If Left(MitRange(i, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(i, 1), LTal + 1, 1)) Then

rettes til

If Left(MitRange(i, 12), LTal) = FindTal And Not IsNumeric(Mid(MitRange(i, 12), LTal + 1, 12)) Then

(Har ikke testet)
Avatar billede scharff Juniormester
06. september 2006 - 12:07 #11
der var lige lidt andet der også skulle rettes men virker sku kanon nu ! jeg takker for din store hjælp ! hvordan giver jeg dig nogle point ?
Avatar billede gider_ikke_mere Nybegynder
06. september 2006 - 12:21 #12
Når jeg har puttet dette svar :-)

Glad for det virker. Husk lige til en anden gang at komme med hele opgaven på en gang. Koden er blevet noget rodet af alle de ændringer.

held og lykke med det.
Avatar billede gider_ikke_mere Nybegynder
21. september 2006 - 22:36 #13
Lukker du?
Avatar billede scharff Juniormester
22. september 2006 - 11:15 #14
ja hvis jeg viste hvordan ?
Avatar billede gider_ikke_mere Nybegynder
22. september 2006 - 11:39 #15
Hej igen.
Markér mit navn ved siden af skrivevinduet, der står nu akyhne og scharff. Klik på acceptér.
Avatar billede gider_ikke_mere Nybegynder
22. september 2006 - 11:40 #16
Imellem nederste/sidste spm. og skrivefeltet...
Avatar billede scharff Juniormester
22. september 2006 - 13:00 #17
Håber det ok nu
Avatar billede gider_ikke_mere Nybegynder
22. september 2006 - 13:06 #18
Fint. Tak for point.
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