dubbele datum overschrijven

[westra77]

hallo

ik heb het volgende probleem
in mijn bestand wordt een invoer gegeven in cellen b2 tot b9
deze wordt door middel van een macro weggeschreven. Indien de datum gelijk is aan de laatst ingevoerde datum, dan overschrijft de macro deze waarden.
echter, ik wil graag dat als de datum in cel b2 voorkomt in de rij vanaf d2 hij deze datum met bijbehorende invoer waarden overschrijft. Momenteel vergelijkt de macro alleen de laatste kolom.
ik heb al gezocht bij ontdubbelen in het forum.
omdat ik echter geen ervaring heb met VBA, kom ik er niet uit .
wie kan mij helpen

 

[Wigi]

Sub voorbeeldWigi()

    Dim rDatums As Range
    Dim i As Integer
    
    Set rDatums = Range("D2:" & Cells(2, Cells(2, Columns.Count).End(xlToLeft).Column).Address)
    
    If WorksheetFunction.CountIf(rDatums, Range("B2").Value) > 0 Then
        
        i = rDatums.Cells(1).Column
        Do Until Cells(2, i).Value = Range("B2").Value
            i = i + 1
        Loop
        
    Else
    
        i = Cells(2, Columns.Count).End(xlToLeft).Column + 1
        
    End If
    
    Range("B2:B9").Copy
    Cells(2, i).PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    Range("B2").Select
    MsgBox "Gegevens werden weggeschreven.", vbInformation

End Sub

Wigi

 

[westra77]

werkt perfect,
bedankt Wigi voor je supersnelle reactie

 

[westra77]

het werkt goed behalve als er voor de eerste keer gegevens moeten worden opgelagen en er dus nog niets is weggeschreven cel d5 tot d12 zijn dan nog leeg

 

[Wigi]

Sub voorbeeldWigi()

    Dim rDatums As Range
    Dim i As Integer

    Set rDatums = Range("D2")

    If rDatums.Value = "" Then

        i = 4

    Else

        Set rDatums = Range("D2:" & Cells(2, Cells(2, Columns.Count).End(xlToLeft).Column).Address)

        If WorksheetFunction.CountIf(rDatums, Range("B2").Value) > 0 Then

            i = rDatums.Cells(1).Column
            Do Until Cells(2, i).Value = Range("B2").Value
                i = i + 1
            Loop

        Else

            i = Cells(2, Columns.Count).End(xlToLeft).Column + 1

        End If
        
    End If

    Range("B2:B9").Copy
    Cells(2, i).PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    Range("B2").Select
    MsgBox "Gegevens werden weggeschreven.", vbInformation

End Sub

Wigi

 

[westra77]

nogmaals bedankt werkt nu goed

 

[Wigi]

nogmaals bedankt werkt nu goed

En begrijp je ook wat er gebeurt in de macro? (zodat je zelf ook kleine wijzigingen kan doen indien nodig)

 

[westra77]

ja Wigi eerst niet, maar met testen en het maken van veranderingen in het voorbeeld bestand begreep ik hem.