Rijen vervangen op basis van celwaarden in bepaalde kolom

Status
Niet open voor verdere reacties.

Ivanhoes

Gebruiker
Lid geworden
6 jun 2015
Berichten
67
Hoi mensen,

Ik wil graag rijen vervangen, op basis van verschillende celwaarden, mbv VBA.
En ik ben nog niet zo bekend met VBA, dus kom ik weer op dit prachtige forum uit.

Meer specifiek:

Tabblad A: Nieuwe gegevens die ingevoerd worden
Tabblad B: Oude gegevens

Ik wil graag dat de oude gegevens in tabblad B vervangen worden door de gegevens in tabblad A.
In spreektaal zou het zo moeten, denk ik:

1 Zoek naar het eerste unieke nummer in tabblad A en vergelijk dit met het unieke nummer in tabblad B
2 Als hetzelfde nummer in beide tabbladen gevonden wordt, vervang dan de betreffende rij in tabblad B
door de gegevens van de betreffende rij uit tabblad A.
3 Zoek het volgende unieke nummer in tabblad A en ga weer verder met regel 3. Ga door totdat alle unieke
nummers in tabblad A, met de range (A6:A15) "behandeld" zijn.

Mijn grootste probleem is hier het zoeken van het unieke nummer in tabblad B, het vervangen van dìe rij
èn dit voor alle regels van het tabblad B te doen, op basis van de unieke nummers in tabblad A.

Ik kan dit zelf berekenen mbv het "gewone" Excel, maar ik vind VBA veel mooier en sneller werken.
Het is in dit geval wel zo dat ik een voorbeeldbestandje heb, maar niet gevuld met code. Ik heb helaas nog niets kunnen
vinden voor iets wat ik nu wil.

Ik hoop dat iemand mij kan helpen.

Alvast bedankt en groetjes,

Ivanhoes.
 

Bijlagen

Dit zou moeten kunnen.
Code:
Sub hsv()
Dim c As Range, cl As Range
For Each c In Sheets("a").Range("a7").CurrentRegion.Offset(1).Resize(, 1)
  For Each cl In Sheets("b").Range("a5").CurrentRegion.Offset(1).Resize(, 1)
    If c = cl Then cl.Resize(, 5) = c.Resize(, 5).Value
  Next cl
Next c
End Sub
 
WOW!!

Het werkt goed en supersnel. Bedankt voor de reactie en de moeite, Harry.
(Alweer!)

Ik begrijp er niets van, maar dat maakt (nog) niet uit. Als ik dit in het originele bestand ga testen
loop ik vanzelf tegen dingen aan. Ga ik het eerst weer zelf proberen.....leer ik van......en als ik er dan
toch niet uitkom, kom ik weer terug.

Maar voor nu: bedankt!

Groetjes,

Ivanhoes

Ps: Als het in het originele bestand ook goed werkt en ik heb geen vragen meer, zal ik dit topic op opgelost zetten.
 
Plaats een msgbox in de code met de vraag erachter waar currentregion zich bevindt.
 
Om het geheel waarschijnlijk iets sneller te maken en wat extra stof tot nadenken:d

Code:
Sub VenA()
With Sheets("b").[A5].CurrentRegion
    ar = .Value
    ar1 = Sheets("a").[A7].CurrentRegion
    For j = 1 To UBound(ar)
        For jj = 1 To UBound(ar1)
            If ar(j, 1) = ar1(jj, 1) Then
                For jjj = 2 To 5
                    ar(j, jjj) = ar1(jj, jjj)
                Next jjj
            End If
        Next jj
    Next j
    .Value = ar
End With
End Sub
 
Dan nog maar een:

Code:
Sub M_snb()
  sn = Sheets("A").Cells(7, 1).CurrentRegion
  sp = Sheets("B").Cells(7, 1).CurrentRegion
  
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sp)
       .Item(sp(j, 2)) = Application.Index(sp, j)
    Next
    For j = 2 To UBound(sn)
       If .exists(sn(j, 2)) Then .Item(sn(j, 2)) = Application.Index(sn, j)
    Next
    
    Sheet3.Cells(20, 1).Resize(.Count, UBound(sp, 2)) = Application.Index(.items, 0, 0)
  End With
End Sub
 
Hoi mensen,

Ik voel mij net een jochie dat nog met bandjes zwemt en nu opeens voor zijn C-diploma moet....... :D
Ik kan helaas niet met jullie meepraten over de door jullie gemaakte codes.

@HSV:
De code werkt zoals het moet. Ik kan hem gedeeltelijk beredeneren. Ik heb ook nog geprobeerd
om bijvoorbeeld alleen de kolommen C:E te op tabblad B te vervangen door de kolommen van
C:E op tabblad A. Dat is mij niet gelukt.
Ik kan inmiddels wel de range vergroten tot 1112 kolommen, door

Code:
If c = cl Then cl.Resize(, 5) = c.Resize(, 5).Value

te vervangen door:

Code:
If c = cl Then cl.Resize(, 1112) = c.Resize(, 1112).Value

Maar nu probeer ik óók nog om de betreffende rijen in tabblad B te vervangen pas vanaf kolom C t/m APT
(In het origineel blijven de kolommen A:B gewoon staan en worden daarna de kolommen C t/m APT vervangen, indien de
waarde in Kolom A gelijk is.)


@VenA
Ik heb jouw code toegepast in mijn eerder meegestuurde bestand. Dat werkte óók goed! Bedankt.
In het origineel heb ik echter kolommen van A t/m APT, in beide tabbladen.
Ik krijg nu foutmelding 9: Het subscript valt buiten het bereik.

Code:
ar(j, jjj) = ar1(jj, jjj)

Ook jouw code kan ik gedeeltelijk beredeneren, maar ik heb nog niet zo'n groot oplossend vermogen mbt VBA.

@SNB
Ik ben hier echt nog wel een beetje te klein voor. Ook hier kan ik sommige dingen nog wel beredeneren, maar zeker niet alles.
Ik ben nog druk aan het leren, dus deze code ga ik zeker ook bewaren en later nog eens goed bestuderen.
Maar voor nu kan ik nog niet tegen jullie op :( .

Hoe dan ook: allen bedankt voor de reacties!

Groetjes,

Ivanhoes.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan