artikel zoeken en waarde artikel van ene lijst bijtellen bij waarde andere lijst

Status
Niet open voor verdere reacties.
T

Tekik

Nieuwe gebruiker
Lid geworden
4 feb 2008
Berichten
4
Graag even uw hulp na 5 avondjes zoeken en uitproberen.
Ik wil het artikel van blad1 opzoeken in een lijst op blad 2. Indien deze is gevonden moet de bijhorende waarde van dit artkel op blad 1 bijgeteld worden bij de waarde op blad 2.
Indien het artikel niet in de lijst staat op blad 2, dan moet dit artikel en de waarde bijgeschreven worden in de lijst.
Ik heb al het een en ander gevonden maar krijg een foutmelding wanneer het artikel niet is gevonden en ik kan ook de waarde op blad1 naar blad 2 brengen.
Waarschijnlijk kan de code ook eenvoudiger geschreven worden. Alvast bedankt.
Bekijk bijlage Map1 - helpmij.xls
 
zo?

Code: 
Sub wegschrijven()

With Sheets("Blad1")
    
    For Each rc In .Range("A5:A" & .Range("a11").End(xlUp).Row)
        With Sheets("Blad2")
            If Not .Range("F5:F500").Find(rc) Is Nothing Then
                    .Range("F5:F500").Find(rc).Offset(, 2) = .Range("F5:F500").Find(rc).Offset(, 2) + rc.Offset(, 1)
            Else
                    X = .Range("F500").End(xlUp).Row + 1
                    .Cells(X, 6) = rc
                    .Cells(X, 8) = rc.Offset(, 1)
            End If
        End With
    Next rc

End With


End Sub
 
Laatst bewerkt:
iets anders uitgevoerd
Code: 
Sub wegschrijven()
  For Each it In Sheets("Blad1").Columns(1).SpecialCells(2).Offset(1).SpecialCells(2)
    With Sheets("Blad2")
      If WorksheetFunction.CountIf(.Columns(6), it) > 0 Then
        .Columns(6).Find(it).Offset(, 2) = .Columns(6).Find(it).Offset(, 2) + it.Offset(, 1)
      Else
        .Cells(Rows.Count, 6).End(xlUp).Offset(1).Resize(, 3) = Array(it, , it.Offset(, 1))
      End If
    End With
  Next
End Sub
 
Beste, heb beide oplossingen getest en het werkt perfect. hartelijk dank.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan