wisselende range

[dvejam]

Goedemiddag,

Ik haal op dag, week en maandniveau data op die ik vervolgens naar een excel kopieer om inzicht te krijgen. Om dit inzicht te krijgen wordt bepaalde data verwijderd, er een kolom toegevoegd en duplicaten verwijderd. Daarnaast heb ik in een eerdere melding gevraag omdat een formule om unieke aantallen in beeld te krijgen. Dit gaat allemaal prima. Om dit niet telkens allemaal handmatig te doen heb ik een macro opgenomen.

Echter loop ik tegen het probleem aan dat de range van de data tekens wisselt. De ene dag/week/maand zijn er meer handelingen dan de andere en dus meer of minder data.

Hoe kan ik dat in een macro verwerken?

Als er een voorbeeld bestand nodig is hoor ik het graag.

Sub MacroKB()
'
' MacroKB Macro
'

'
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AH$40489").AutoFilter Field:=6, Criteria1:="=B", _
Operator:=xlOr, Criteria2:="=K"
Rows("2995:40602").Select
Selection.ClearContents
Selection.AutoFilter
Columns("T:T").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("T1").Select
ActiveCell.FormulaR1C1 = "Gem aant"
Range("T2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
Range("T2").Select
Selection.AutoFill Destination:=Range("T2:T2994")
Range("T2:T2994").Select
Cells.Select
Selection.Copy
Sheets("data KB").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$AI$40489").RemoveDuplicates Columns:=Array(9, 14), _
Header:=xlYes
Sheets("data MdW").Select
ActiveWindow.LargeScroll ToRight:=1
Range("AJ1").Select
ActiveCell.FormulaR1C1 = "Aantal"
Range("AJ2").Select
ActiveCell.FormulaR1C1 = "=N"
ActiveWindow.LargeScroll ToRight:=1
ActiveCell.FormulaR1C1 = _
"=N(SUMPRODUCT((R2C14:RC[-22]=RC[-22])*(R2C31:RC[-5]=RC[-5]))<2)"
Range("AJ2").Select
Selection.AutoFill Destination:=Range("AJ2:AJ2994")
Range("AJ2:AJ2994").Select
End Sub

 

[Meaurk]

Heb je "Range(Selection, Selection.End(xlDown)).Select" al eens geprobeerd bij de betreffende kolom(men) welke veranderen?

 

[dvejam]

Nee, ik ga kijken of mij dat lukt.

 

[dvejam]

Goedemiddag,

Ik heb het geprobeerd maar krijg het niet voor elkaar. Excuses maar niet genoegd kennis van VBA.

 

[HSV]

Upload een voorbeeldbestand.
De code die je toont is met de recorder opgenomen en bevat veel ballast.

 

[dvejam]

Harry,

Bij deze met uitleg van de stappen en een voorbeeld bestand.

1) opgehaalde data wordt in tabblad Data MdW geplakt
2) In kolom F wordt alles met waarde B of K verwijderd
3) Tussen kolom S en T wordt een kolom toegevoegd met koptekst Gem Aant en daarin wordt formule =R2-S2 toegevoegd en vervolgens doorgevoerd.
4) Dan wordt alle data geselecteerd en gekopieerd naar tabblad data KB
5) op tabblad data KB word duplicaten verwijderd op Rc (kolom I) en op order (Kolom N)
6) Dan ga ik weer terug naar tabblad Data Mdw en daar voeg ik in Kolom AI koptekst Aantal in en vervolgens vanaf cel AI2 de formule =N(SOMPRODUCT(($N$2:N2=N2)*($AE$2:AE2=AE2))<2). Deze wordt ook weer helemaal doorgevoerd.

Groet, Dennis

 

[Leotaxi]

iets in deze aard

Sub test()
With Sheets("Data MdW")
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    Columns("T:T").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("T1").FormulaR1C1 = "Gem aant"
    .Range("T2", "T" & lr).FormulaR1C1 = "=RC[-2]-RC[-1]"
    .Range("A1", "AH" & lr).AutoFilter Field:=6, Criteria1:="=B", Operator:=xlOr, Criteria2:="=K"
    Application.DisplayAlerts = false
    With Sheets("Data MdW").Range("A1").CurrentRegion
        .Offset(1).Delete
    End With
    Application.DisplayAlerts = True
    .Range("A1", "AH" & lr).AutoFilter
    sn = .Range("A1").CurrentRegion
    With Sheets("data KB")
        .Range("A1").Resize(UBound(sn), 35) = sn
        .Range("A1", "AI" & lr).RemoveDuplicates Columns:=Array(9, 14), Header:=xlYes
    End With
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("AJ1").FormulaR1C1 = "Aantal"
    .Range("AJ2", "AJ" & lr).FormulaR1C1 = "=N(SUMPRODUCT((R2C14:RC[-22]=RC[-22])*(R2C31:RC[-5]=RC[-5]))<2)"
End With
End Sub

mvg
Leo

 

[ClickandKnow]

Wouw! alleen een kleine typo op regel 8 fale --> false
Maar dat doet niks aan de code af!

 

[Leotaxi]

bij deze aangepast

 

[HSV]

Als je de code goed toepast heb je die coderegel ook niet nodig.
Maar wie is wie in deze vraag eigenlijk?
M.a.w. wat heeft @ClickandKnow met @dvejam van doen?

Sub hsv()
 With Sheets("data mdw").Cells(1).CurrentRegion
    .AutoFilter 6, "K", 2, "B"
    .Parent.AutoFilter.Range.Offset(1).SpecialCells(12).EntireRow.Delete
    .AutoFilter
    .Columns(20).Insert
    .Cells(1, 20) = "Gem Aant"
    .Range("t2:t" & .Cells(Rows.Count, 19).End(xlUp).Row) = "=RC[-2]-RC[-1]"
    .Copy Sheets("data kb").Cells(1)
   Sheets("data kb").Cells(1).CurrentRegion.RemoveDuplicates Array(9, 14), xlYes
    .Cells(1, 36) = "Aantal"
    .Range("aj2:aj" & .Cells(Rows.Count, 36).End(xlUp).Row) = "=N(SUMPRODUCT((R2C14:RC[-22]=RC[-22])*(R2C31:RC[-5]=RC[-5]))<2)"
 End With
End Sub

 

[ClickandKnow]

Niks, ik was zelf ook bezig om de uitdaging van dvejam met vba op te lossen. Maar leotaxi was mij voor en met een veel betere oplossing dan ik had kunnen bedenken... Vandaar mijn bewondering voor zijn snelheid en professionele code.

Zal voortaan mijn commentaar voor me houden als het om een typo en bewondering gaat...

 

[HSV]

Ach zo; Ik dacht dat het één en dezelfde persoon was.
Prima toch die bevlieging.

 

[ClickandKnow]

Aha vandaar je reactie, snap uhm...

 

[dvejam]

Ben nu niet thuis maar alvast bedankt voor de hulp. Kijk er morgen naar.

Fijne avond

 

[dvejam]

Goedemorgen,

Zojuist de code van Harry getest en die werkt prima m.u.v. van doorvoeren kolom AJ (36). Daar wordt alleen de formule ins cel AJ2 geplakt en niet doorgevoerd.

 

[Leotaxi]

vermoedelijk dit aanpassen

.Range("aj2:aj" & .Cells(Rows.Count, [COLOR="#FF0000"]36[/COLOR]).End(xlUp).Row) = "=N(SUMPRODUCT((R2C14:RC[-22]=RC[-22])*(R2C31:RC[-5]=RC[-5]))<2)"

naar

.Range("aj2:aj" & .Cells(Rows.Count, [COLOR="#FF0000"]1[/COLOR]).End(xlUp).Row) = "=N(SUMPRODUCT((R2C14:RC[-22]=RC[-22])*(R2C31:RC[-5]=RC[-5]))<2)"

mvg
Leo

 

[dvejam]

Leo, super bedankt. Dat is inderdaad de oplossing.

Ik weet niet of ik heel brutaal maar heeft iemand nog een suggestie om de formule in kolom AJ2 komt sneller te maken. Deze formule neemt veel rekencapaciteit in beslag en gaat iedere keer de cellen opnieuw berekenen. Ik kan dat uitzetten onder opties maar is niet de oplossing.

Of moet ik een computer met snellere processor kopen :d

 

[Leotaxi]

zijn er nog berekingen nodig nadat volledige transformatie heeft plaatsgevonden ?
anders zou je de uitkomsten kunnen plaatsen in plaats van de formules


mvg
Leo

 

[dvejam]

nee er zijn geen berekeningen meer nodig meer nodig. Ik heb alleen de uitkomsten nodig.

 

[Leotaxi]

juist na deze

.Range("aj2:aj" & .Cells(Rows.Count, 1).End(xlUp).Row) = "=N(SUMPRODUCT((R2C14:RC[-22]=RC[-22])*(R2C31:RC[-5]=RC[-5]))<2)"

deze plaatsen

.Range("aj2:aj" & .Cells(Rows.Count, 1).End(xlUp).Row).value =.Range("aj2:aj" & .Cells(Rows.Count, 1).End(xlUp).Row).value

mvg
Leo