Slet udvalgte data fra regneark

prøv at teste denne


Private Sub CommandButton1_Click()
    Dim R As Long, I As Long, Svar As String
    Svar = InputBox("Indtast et heltal")
    I = Range("C65536").End(xlUp).Row
    For R = I To 1 Step -1
        If Cells(R, 3) = "SUM" And Cells(R, 4).Value < Val(Svar) Then
            I = R
            Do Until Cells(R, 2) = "Root"
                R = R - 1
            Loop
            Rows(R & ":" & I).Delete
        End If
    Next
End Sub

:o( den gør det ikke rigtigt

Hvad er ikke rigtig

Sletter den de forkerte, eller gør den ingenting

Står der SUM som tekst i kolonne C og står der Root som tekst i kolonne B

Den er ikke konsekvent når den sletter ... gennemgår lige procennse for at se hvor den fejler ... vender tilbage

Jeg kan ikke lige greje hvad går galt ... kan jeg maile det til dig ... men en forklaring ?

ja, send et eksempel ark

kabbak snabela tiscali dot dk

Kan godt se problemet nu ... den kolonne du benytter til at identificerer SUM, indeholder SUM flere gange indenfor samme kundeid ( kolonne A ) ... jeg skal udelukkende måle på SUM første gang ( i Root ), svarende til totalsummen

Jeg kan se at du tjekker værdien, i kolonne G 'Måneden budget', er det den den skal kikke på eller er det  Kolonne F 'Måneden Realiseret'

Da der er tale om en model, som skal kunne foretage segmentering på flere af kolonnerne ... det som den kigger på nu, er korrekt månedens budget :o)

Hej igen, jeg har lige lavet lidt om i koden, men jeg tror at det er måden du indtaster på.

prøv at skrive 50000 uden det komma, så vidt jeg kan se regner i ikke med ører, og tusindtals separator er ikke nødvendig.

Sub SelectBudget()

    Dim R As Long, I As Long, Svar As String, Tal As Double
    Application.ScreenUpdating = False
    Svar = UserForm1.SegmentKriterie
    Tal = Val(Svar)
    Sheets("Data").Select
    I = Range("E65536").End(xlUp).Row
    For R = I To 1 Step -1
        If InStr(1, Cells(R, 5).Text, "Resultat") > 0 And Cells(R, 7).Value < Tal Then
            I = R
            Do
                R = R - 1
            Loop Until InStr(1, Cells(R, 4).Text, "ROOT") > 0
            Rows(R & ":" & I).EntireRow.Delete
          I = R + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Hej igen igen

Den er helt gal ... hvis du kigger på kunde/ordregiver 10039407, indeholder den i det oprindelige datasæt ( SAPData ) 18 rækker ( fra række 218 - 235 ), og kun 6 efter valg af 100.000 kr. som segmentgrænse ... ???

Der udelukkende skal måles på den resultatlinie du ser i linie 228, svarende til totalsummen for ROOT ... Hvis resultatet her er større end 100.000, skal hele posten, altså alle 28 linier bevares, ellers skal de alle slettes.

Håber jeg har forklaret mig ordentligt :o)

koden kører jo ikke i SAPData, den kører i arket data

Ok jeg ser problemet, vender tilbage

Den er jeg med på, men det var mere for at du kunne se før/efter resultatet

prøv at teste denne

Sub SelectBudget()

    Dim R As Long, I As Long, Svar As String, Tal As Double, X As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Svar = UserForm1.SegmentKriterie
    Tal = Val(Svar)
    Sheets("Data").Select
    I = Range("E65536").End(xlUp).Row
    For R = I To 1 Step -1
        If InStr(1, Cells(R, 5).Text, "Resultat") > 0 And Cells(R, 7).Value < Tal Then
            X = R
            Do
                R = R - 1
            Loop Until InStr(1, Cells(R, 4).Text, "ROOT") > 0
            Rows(R & ":" & X).EntireRow.Delete
        Else
            Do
                R = R - 1
                If R < 2 Then GoTo Slut
            Loop Until InStr(1, Cells(R, 4).Text, "ROOT") > 0
        End If
    Next
Slut:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Får du også 37 tilbage ved et SegmentKriterie = 100000 ... deg gør jeg, men reelt er der langt flere ... o det oprindelige datasæt ( mere end 100 har jeg kunnet tælle mig frem til ) ... :o(

Jeg har også 37, kikker videre

Troede også lige den var løst :o(

Jeg tjekkede lige med filter

Der er 309 ROOT

Ud af dem er der 37 der har over 100000 i Måneden Budget

så ud fra det, burde koden passe

Jeg tror vi kigger på det forkerte ...

Hvis du tager kunde/ordregiver 10039187 så har denne en samlet resultat på 647.903 kr for de 12 perioder i ROOT ... hvorfor segmenteres denne fra når der kun skal fravælges kunder under 100.000 ????

Så må du vist forklare lidt mere.

Koden køre nedefra og op.
Første gang den møder et Resultat, tjekker den 'Måneden budget', er den under den valgte værdi, slettes alle rækker , til og med der hvor den møder ~ROOT.

Den kikker altså kun på det nederste resultat og ikke de mellemliggende

Se så er det her vi er gået helt galt ....

Ordregiver/ROOT er her posten starter og så nedad ... første gang der efter ROOT findes et resultatfelt + 2 kolonner mod højre, er her vi måler i forhold til vores segmentkriterie. Er den værdi her større end segmentkriterie, skal hele datasættet beholdes ( fra første ROOT til næste ROOT starter ) ... altså nedad ...

Beklager hvis vi er gået galt her :o(

Jeg er på vej til køjs ... skal du ikke det samme ???

Det er vel også mig der ikke læser ordentlig.
Det gjorde det nu ikke nemmere at resultatet stå et sted imellem 2 ROOT, men mon denne ikke kører, jeg får ihvertfal flere med


Prøv denne


Sub SelectBudget()

    Dim R As Long, I As Long, Svar As String, Tal As Double, X As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Svar = UserForm1.SegmentKriterie
    Tal = Val(Svar)
    Sheets("Data").Select
    I = Range("E65536").End(xlUp).Row
    X = I
    For R = I To 1 Step -1
        If InStr(1, Cells(R, 4).Text, "ROOT") > 0 Then X = Cells(R, 4).Offset(-1, 0).Row
        If InStr(1, Cells(R, 5).Text, "Resultat") > 0 And Cells(R, 7).Value < Tal _
          And InStr(1, Cells(R, 4).End(xlUp), "ROOT") > 0 Then
          R = Cells(R, 4).End(xlUp).Row
            Rows(R & ":" & X).EntireRow.Delete
            X = R - 1
        End If
    Next
Slut:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Jeg går i seng nu ;-))

Det ser meget mere fornuftigt ud ... jeg tror den er der :o)

Den er der :o)

Så skal der leges lidt med varianter af udtræk ...

Hvordan sen koden ud, hvis der skal segmenteres efter følgende kriterier :

    Alle kunder med 0-omsætning samt budget over xxx.xxx

Den realiserede omsætning ( som både kan være 0 og null ) står i kolonnen umiddelbart før budgetkolonnen

Hvis jeg må skrive i en tom kollonne og bruge variabler, så vil den blive hurtigere og du kan bruge samme kode til alle

Du har vel efterhånden gennemskuet systematikken, så feel free :o)

... blot det du vil gøre indarbejdes i "Data" ... og den ekstra databerigelse kan slettes/skjules efter succesfuld segmentering ... resultaterne fra arkfanen "Data" bearbejdes ydeligere efter segmentering

Så er jeg tilbage ;-))

Jeg har lavet en ny kode og rette lidt i din,Filen er sendt retur via mail.

Din kommandoknap kode

Private Sub CommandButton1_Click()

    OpretDataArk
    SelectBudget 7    ' 7 tallet betyder at det er i kollonne 7 at resultatværdierne findes
    '              Hvis du laver flere knapper kan du bruge samme procedure, bare skriv en anden kolonne
    Me.Hide    ' skjuler userformen
End Sub



Min kode:


Sub SelectBudget(Nr As Long)
    Dim Svar As String, Tal As Double, Ws As Worksheet, I As Long
    Dim Sdata As Variant, SumData As Variant, Tjek As Variant
    Dim N As Long, X As Long, ROOTtilbage As Integer, ROOTialt As Integer
    Dim fROOT As Long, sROOT As Long, Slet As Boolean
    ROOTtilbage = 0
    ROOTialt = 0
    Application.ScreenUpdating = False    ' slår opdateringen af  skærmen fra
    Application.Calculation = xlCalculationManual    ' Slår automatisk regning fra
    Svar = UserForm1.SegmentKriterie
    Tal = Val(Svar)
    Set Ws = Sheets("Data")    ' Ret til dit ark
    Ws.Activate

    I = Ws.Range("E65536").End(xlUp).Row    ' Finder antal rækker
    Sdata = Ws.Range("D1:E" & I + 1)    ' Kollonne D og E læses ind i en variabel
    SumData = Ws.Range(Cells(1, Nr), Cells(I, Nr))    ' den valgte sumkollonne læses ind i en variabel
    Tjek = Ws.Range("IV1:IV" & I)    ' Opretter en variabel til at skrive i om rækken skal slettes eller ej
    Tjek(1, 1) = "Tjek"    ' Overskrift på kollonne IV
    Slet = False

    For N = 2 To I
        If InStr(1, Sdata(N, 1), "ROOT") > 0 Then ROOTialt = ROOTialt + 1    ' tællar antal ROOT inden udvælgelse
    Next

    For N = 2 To I
        If InStr(1, Sdata(N, 1), "ROOT") > 0 Then fROOT = N    ' første ROOT's række
        If InStr(1, Sdata(N, 2), "Resultat") And SumData(N, 1) > Tal Then Slet = True    ' Tjekker på første resultat
        If InStr(1, Sdata(N + 1, 1), "ROOT") > 0 Or N + 1 > I Then    ' Finder rækken over næste ROOT eller enden af data
            sROOT = N    'Næste ROOT's række
            If Slet Then    ' Hvis de IKKE skal slettes, skrives ettaller
                For X = fROOT To sROOT
                    Tjek(X, 1) = 1
                Next
                Slet = False
                ROOTtilbage = ROOTtilbage + 1
                fROOT = N + 1
            End If
        End If
    Next

    Ws.Range("IV1:IV" & I) = Tjek    ' Skriver 1 eller blank i IV kolonnen
    Ws.Range("IV1:IV" & I).SpecialCells(xlCellTypeBlanks).EntireRow.Delete    ' Sletter de tomme
    Ws.Range("IV1:IV" & I).ClearContents    ' Tømmer kolonne IV for ettaller
    Set Ws = Nothing    ' Frigør hukommelse
    Application.Calculation = xlCalculationAutomatic    ' Slår automatisk regning til igen
    Application.ScreenUpdating = True    ' Opdaterer skærmen
    MsgBox "Antal ROOT tilbage = " & ROOTtilbage & " af " & ROOTialt
End Sub

Det skulle vist være et svar ;-))

Det er ligetil ... og skié godt ... men ... sorry ...

... i det eksempel jeg beskrev 04/10-2006 10:00:42, er der tale om 2 kriterier jeg vil segmentere på, nemlig om omsætningen i kolonne 6 er 0 eller Null og budgettet i kolonne 7 er større end XX kr ...

Det kan jeg ikke lige se hvordan det er muligt med din nye kode ... 

Det kunne jeg lettere gennemskue med den gamle kode :

If InStr(1, Cells(R, 5).Text, "Resultat") > 0 And Cells(R, 7).Value < Tal _

Men et forsøg med dette gav ikke det ønskede resultat

If InStr(1, Cells(R, 5).Text, "Resultat") > 0 And Cells(R, 6).Value = 0 And Cells(R, 7).Value < Tal _

Du skal bare køre funktionen 2 gange uden at forny arket.

1. gang

  SelectBudget 7 
2. gang

  SelectBudget 6

Det gør at den først fjerne dem under f.eks. 100000,
derefter fjerner den dem i kolonne 6 som er mindre en det du skriver i inputboksen

Ok smart ... tester lige :o)

Øv, den er ikke lige til højrebenet, fordi SelectBudget 6 ikke er en værdi som kan aflæses i SegmentKriterie ... her skal værdien være præcis 0 eller Null

Jeg mangler et eller andet med

If SelectBudget = 7 Then
Noget andet
else
Det første

Kan ikke lige se hvor det kan indarbejdes :o(

Sorry ...
If SelectBudget = 6 Then

Sub SelectBudget(Nr As Long)
    Dim Svar As String, Tal As Double, Ws As Worksheet, I As Long
    Dim Sdata As Variant, SumData As Variant, Tjek As Variant
    Dim N As Long, X As Long, ROOTtilbage As Integer, ROOTialt As Integer
    Dim fROOT As Long, sROOT As Long, Slet As Boolean
    ROOTtilbage = 0
    ROOTialt = 0
    Application.ScreenUpdating = False    ' slår opdateringen af  skærmen fra
    Application.Calculation = xlCalculationManual    ' Slår automatisk regning fra
    Svar = UserForm1.SegmentKriterie
    Tal = Val(Svar)
    Set Ws = Sheets("Data")    ' Ret til dit ark
    Ws.Activate

    I = Ws.Range("E65536").End(xlUp).Row    ' Finder antal rækker
    Sdata = Ws.Range("D1:E" & I + 1)    ' Kollonne D og E læses ind i en variabel
    SumData = Ws.Range(Cells(1, Nr), Cells(I, Nr))    ' den valgte sumkollonne læses ind i en variabel
    Tjek = Ws.Range("IV1:IV" & I)    ' Opretter en variabel til at skrive i om rækken skal slettes eller ej
    Tjek(1, 1) = "Tjek"    ' Overskrift på kollonne IV
    Slet = False

    For N = 2 To I
        If InStr(1, Sdata(N, 1), "ROOT") > 0 Then ROOTialt = ROOTialt + 1    ' tællar antal ROOT inden udvælgelse
    Next

    For N = 2 To I
        If InStr(1, Sdata(N, 1), "ROOT") > 0 Then fROOT = N    ' første ROOT's række
        If Nr = 7 Then
            If InStr(1, Sdata(N, 2), "Resultat") And SumData(N, 1) > Tal Then Slet = True    ' Tjekker på første resultat
        Else
            If InStr(1, Sdata(N, 2), "Resultat") And SumData(N, 1) <> 0 Or Not IsEmpty(SumData(N, 1)) Then Slet = True
            ' Tjekker om resultatet er forskellig fra 0 og tom
        End If
        If InStr(1, Sdata(N + 1, 1), "ROOT") > 0 Or N + 1 > I Then    ' Finder rækken over næste ROOT eller enden af data
            sROOT = N    'Næste ROOT's række
            If Slet Then    ' Hvis de IKKE skal slettes, skrives ettaller
                For X = fROOT To sROOT
                    Tjek(X, 1) = 1
                Next
                Slet = False
                ROOTtilbage = ROOTtilbage + 1
                fROOT = N + 1
            End If
        End If
    Next

    Ws.Range("IV1:IV" & I) = Tjek    ' Skriver 1 eller blank i IV kolonnen
    Ws.Range("IV1:IV" & I).SpecialCells(xlCellTypeBlanks).EntireRow.Delete    ' Sletter de tomme
    Ws.Range("IV1:IV" & I).ClearContents    ' Tømmer kolonne IV for ettaller
    Set Ws = Nothing    ' Frigør hukommelse
    Application.Calculation = xlCalculationAutomatic    ' Slår automatisk regning til igen
    Application.ScreenUpdating = True    ' Opdaterer skærmen
    MsgBox "Antal ROOT tilbage = " & ROOTtilbage & " af " & ROOTialt
End Sub

jeg briger en lidt forkert navngive Boolean, den burde ikke hedde Slet, men Behold

Hvis Slet = True , så beholdes data

Har du testet den, hvor eksempelvis sætter værdien 0 i SAPData i Celle E37 så burde du som minimum få een rapport/selection

Tværtimod for du næsten alle ?

Glem resten :o)

Jeg kører 0-omsætningen på "gammeldags" vis :

Dim R As Long, I As Long, Svar As String, Tal As Double, X As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Svar = 0
    Tal = Val(Svar)
    Sheets("Data").Visible = True
    Sheets("Data").Select
    I = Range("E65536").End(xlUp).Row
    X = I
    For R = I To 1 Step -1
        If InStr(1, Cells(R, 4).Text, "ROOT") > 0 Then X = Cells(R, 4).Offset(-1, 0).Row
        If InStr(1, Cells(R, 5).Text, "Resultat") > 0 And Cells(R, 6).Value <> Tal _
          And InStr(1, Cells(R, 4).End(xlUp), "ROOT") > 0 Then
          R = Cells(R, 4).End(xlUp).Row
            Rows(R & ":" & X).EntireRow.Delete
            X = R - 1
        End If
    Next
Slut:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

og fortsætter derefter med den nye kode ... det er ok :o)

Du fortjener mindst til 10-dobbelte

Taj Jensen363 og tak for karma ;-))

Velbekommen ... der kommer lige et tillægsspørgsmål ( opretter det lige )