Alleen opnemen indien waarde

[S.Teeling]

Hallo, ik heb het volgende probleem. Ik wil een journaalpost samenstellen maar de regels met een waarde 0,00 mogen niet worden meegenomen (het inlezen loopt hierop vast). Daar dit een terugkerend iets is wil ik dit graag middels een formule om VB code oplossen. Ik heb van alles geprobeerd maar kom niet verder.

Het zijn maximaal 6 regels maar het kunnen er dus ook minder zijn.

Zie verder bijgaand voorbeeldje

 

[Wigi]

Sub geennullen()
Dim c As Range, lngRow As Long, number1 As Double, number2 As Double
lngRow = 22
For Each c In Range("C9:C14")
    
    If IsNumeric(c.Offset(0, 2)) Then
        number1 = c.Offset(0, 2)
    Else: c.Offset(0, 2) = 0
    End If
    
    If IsNumeric(c.Offset(0, 3)) Then
        number2 = c.Offset(0, 3)
    Else: number2 = 0
    End If
    
    If number1 + number2 > 0 Then
        c.Resize(1, 4).Copy Range("C" & lngRow)
        lngRow = lngRow + 1
    End If
Next
End Sub

Wigi

 

[S.Teeling]

Wigi,

bedankt voor je reactie. Ik heb nog de volgende vraag. Is het mogelijk deze code op te nemen onder "Private Sub Worksheet_Change(ByVal Target As Range)" ?

Als ik dat doe kom ik in regel < lngRow = lngRow + 1 > in een loop terecht. Verder lukt het mij niet om in het stuk "Private Sub Worksheet_Change(ByVal Target As Range)" de cellen te legen. Dit moet wel want wanneer de volgende journaalposst kleiner is blijven er regels staan.

Onder een button werk het overigens wel.

Ik begrijp niet wat deze code allemaal doet, is het mogelijk e.e.a. iets toe te lichten.

 

[Wigi]

Probeer dit dan eens uit:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("C9:F14"), Target) Is Nothing Then

    Range("C22:F27").ClearContents
    
    Application.EnableEvents = False
    
    Dim c As Range, lngRow As Long, number1 As Double, number2 As Double
    lngRow = 22
    For Each c In Range("C9:C14")
        
        If IsNumeric(c.Offset(0, 2)) Then
            number1 = c.Offset(0, 2)
        Else: c.Offset(0, 2) = 0
        End If
        
        If IsNumeric(c.Offset(0, 3)) Then
            number2 = c.Offset(0, 3)
        Else: number2 = 0
        End If
        
        If number1 + number2 > 0 Then
            c.Resize(1, 4).Copy Range("C" & lngRow)
            lngRow = lngRow + 1
        End If
    Next
    
    Application.EnableEvents = True
End If
End Sub

Wat dit doet is:

wanneer een cel wijzigt in bereik C9:F14, dan wordt het tweede bereik gewist en wordt het opnieuw gevuld. Voor elke rij in de gegevens vraag je je af: is debet en credit een getal? Die vinden we met c.offset(0,2) en c.offset(0,3). Want soms zijn dat formules en dan zetten we ze op 0. Als dan debet + credit 0 is, dan mag de rij niet voorkomen in het tweede bereik en gaan we naar de volgende rij. Anders gaan we ook naar de volgende rij, maar zetten we eerst de rij met gegevens over (copy). Wat achter de copy staat is de plaats waar de cellen neergezet moeten worden.

Nu duidelijk?

Wigi

 

[S.Teeling]

Wigi, dit werkt beter. Alleen de formule in de regel met de resultaat berekening gaat niet goed. Deze wordt verwijderd (dit is regel 13).

De cellen worden nu gevuld vanaf rij 22 in dezelfde kolom, is het ook mogelijk dit naar een andere kolom te verplaatsen ?

 

[Wigi]

Beide zijn aangepast:

- het eerste was een typfout van mij
- het tweede: zie opmerking met tekst in macro

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("C9:F14"), Target) Is Nothing Then

    Range("C22:F27").ClearContents
    
    Application.EnableEvents = False
    
    Dim c As Range, lngRow As Long, number1 As Double, number2 As Double
    lngRow = 22
    For Each c In Range("C9:C14")
        
        If IsNumeric(c.Offset(0, 2)) Then
            number1 = c.Offset(0, 2)
        Else: number1 = 0
        End If
        
        If IsNumeric(c.Offset(0, 3)) Then
            number2 = c.Offset(0, 3)
        Else: number2 = 0
        End If
        
        If number1 + number2 > 0 Then
            c.Resize(1, 4).Copy Range("C" & lngRow)   'verander hier de C in de kolom die je wil
            lngRow = lngRow + 1
        End If
    Next
    
    Application.EnableEvents = True
End If
End Sub

Wigi

 

[S.Teeling]

Wigi, bedankt. Deze werkt perfect.