Opgelost Variabel bereik som.als

[DeArie]

Is het mogelijk om een variabel bereik in te stellen in vba voor som.als?

Ik heb het volgende maar krijg het niet werkende helaas:

Sub TestPiektoeslag()
'
' TestPiektoeslag Macro

   Dim LastRow               As Integer


    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown

    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "Piektoeslag Pakketten"
    
   ' Range("C" & Rows.Count).End(xlUp).Offset(1).Select
   ' ActiveCell.FormulaR1C1 = "=SUMIF(R[10]C[2]:R[24]C[2],""*pakket*"",R[10]C[3]:R[23]C[2])"
  
   LastRow = Range("C" & Rows.Count).End(xlUp).Offset(1).Select

   ActiveCell.FormulaR1C1 = "=INDEX(SUMIF(B10:B" & LastRow & ",""*pakket*"",C10:C" & LastRow & "),)"
  
 
End Sub

Ik krijg dan de fout 1004 tijdens uitvoering, door de toepassing of door object gedefineerde fout.

 

[HSV]

Maak gebruik van een dynamisch tabel.

Sub hsv()
With Sheets(1).ListObjects(1).DataBodyRange
 ActiveCell = Evaluate("sumif(" & .Columns(2).Address & ",""*Pakket*""," & .Columns(ActiveCell.Column).Address & ")")
End With
End Sub

 

[emields]

je kan het natuurlijk ook zo doen

 

[DeArie]

Beste HSV,

Dankjewel, alleen ik kreeg hem niet aan de gang door mijn gebrek aan kennis met vba en ik dus ook niet weet hoe ik een dynamische tabel juist moet toepassen.

Emields dankjewel voor jouw oplossing, heb hem aangepast naar hoe ik hem voor ogen had en hij werkt fantastisch!

Sub Piektoeslag()
'
' Piektoeslag Macro

 
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown

    x = [a200].End(xlUp).Offset(1).Row
    y = Application.SumIf(Range([b10], Cells(x, 2)), "*pakket*", Range([c10], Cells(x, 3)))
    With Cells(x, 3).Resize(, 8).Borders(xlEdgeTop)
 
    End With
    Cells(x, 2) = "Piektoeslag pakketten"
    Cells(x, 3) = y
  
   Range("G24").Select
    Selection.Copy
    Range("G25").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("I24").Select
    Selection.Copy
    Range("I25").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("E25").Select
    ActiveCell.FormulaR1C1 = "0.25"
  
 
End Sub

 

[DeArie]

Sub Piektoeslag()
'
' Piektoeslag Macro

 
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown

    x = [a200].End(xlUp).Offset(1).Row
    y = Application.SumIf(Range([b10], Cells(x, 2)), "*pakket*", Range([c10], Cells(x, 3)))
    With Cells(x, 3).Resize(, 8).Borders(xlEdgeTop)
 
    End With
    Cells(x, 2) = "Piektoeslag pakketten"
    Cells(x, 3) = y
  
   Range("G10").Select
    Selection.Copy
    Cells(x, 7).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("I10").Select
    Selection.Copy
    Cells(x, 9).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Cells(x, 5).Select
    ActiveCell.FormulaR1C1 = "0.25"
  
 
End Sub

nog iets aan gepast het laatste beetje liep niet helemaal goed

 

[emields]

Waarom een rij toevoegen? zo verlies je uw formules.

het volgende doet juist hetzelfde maar als de prijs van de toeslag veranderd moet je niet beginnen prutsen in uw macro.

 

[DeArie]

Daar heb je helemaal gelijk in vandaar ook het laatste stukje wat ik heb toegevoegd, die toeslag veranderd maar 1 keer per jaar daarom heb ik daarvoor gekozen heb op deze manier.

Maar zonder de rest van uw code was me dat niet gelukt

 

[HSV]

Hier met een dynamisch tabel.

Weinig code voor nodig.

Sub hsv()
With Sheets(1).ListObjects(1)
  .ListRows.Add
  .DataBodyRange.Cells(.ListRows.Count, 2) = "Piektoeslag pakketten"
End With
End Sub

 

[DeArie]

Duidelijk dankjullie