Cell waarde zoeken en meerdere waarden vervangen

[Juser100]

Hallo,

Ik heb een 2-tal sheets waarbij op sheet 1 waarden staan in de cellen A4 t/m G4. Van deze waarden is de waarde in cel A4 een samengesteld van B4 en C4 en dus altijd uniek (sleutelwaarde). Ik heb een macro opgenomen waarmee de selectie (A4:G4) wordt gekopieerd en vervolgens word ingevoegd op sheet 2 in rij 2.

Graag zou ik willen dat er via vba eerst een controle plaatsvind of de sleutelwaarde van A4 al voorkomt op sheet 2. Indien aanwezig zouden alle aanwezige waarden vervangen moeten worden door de waarden van sheet 1.

Mijn vraag is hoe doe ik dit in VBA??

 

[Roncancio]

Het kan wel via VBA maar zo te lezen zou je met een zoekformule al volstaan.
Kan je een voorbeeldbestand bijsluiten zodat we kunnen zien wat de bedoeling is.

Met vriendelijke groet,


Roncancio

 

[Juser100]

Bedankt voor je snelle reactie!

Zie het bestand voor wat ik tot nog toe in elkaar geknutseld heb.

Bekijk bijlage zoeken-vervangen-waarden.xls

 

[Juser100]

Aangezien er geen reacties meer zijn gekomen ben ik zelf op onderzoek uitgegaan. Weet inmiddels dat ik met Find de waarde in sheet2 moet laten opzoeken die op sheet1 staat.

Het volgende heb ik nu in gebruik:

If Not Sheets("Inv_productgroep_data").Cells.Find(Sheets("Invoer per productgroep").Range("A4") _
  , After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows _
  , SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) _
Is Nothing Then ActiveCell.EntireRow.Delete

Sheets("Invoer per productgroep").Select
If [G4] <> "X" Then GoTo data_invoer
Exit Sub
data_invoer:
    Sheets("Invoer per productgroep").Range("A4:G4").Select
    Selection.Copy
    Sheets("Inv_productgroep_data").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
    Selection.Font.ColorIndex = 0
    Selection.Interior.ColorIndex = xlNone
    Selection.FormatConditions.Delete
    Range("A1").Select
    Sheets("Invoer per productgroep").Select
End Sub

Wat ik wil bereiken is het volgende:
- Controleren of de waarden (op basis van cel A4 op sheet1) al aanwezig is in sheet2;
- Indien niet aanwezig de waarden (indien volledig ingevuld) in sheet1 wegschrijven in rij 2 op sheet2;
- Indien wel aanwezig de waarden op sheet2 vervangen door de ingevulde waarden in sheet1;
- Uiteindelijk als alles er goed in staat op sheet 2 terugkeren naar sheet1.

Wat er nu gebeurd met bovenstaande code is dat er na het invoegen op sheet2 een rij wordt verwijderd op sheet1??

Hoe krijg ik de macro/vba code zodanig dat dit werkt zoals ik het graag wil??

 

[ExcelAmateur]

Juser100,

Ik heb er weinig verstand van maar zou dit helpen?
Er staat "EntireRow.Delete" , heb er nu "Exit Sub" van gemaakt.

If Not Sheets("Inv_productgroep_data").Cells.Find(Sheets("Invoer per productgroep").Range("A4") _
  , After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows _
  , SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) _
Is Nothing Then Exit Sub

 

[Gert Bouwmeeste]

Niet unieke sleutelwaarde

Van deze waarden is de waarde in cel A4 een samengesteld van B4 en C4 en dus altijd uniek (sleutelwaarde)

Da's niet helemaal zo. De combinatie B en C van 1 12 en 11 2 geeft in beide gevallen een sleutel 112

 

[Gert Bouwmeeste]

Ik begrijp niet helemaal wat je nu eigenlijk wilt. Ik zie dat je een rij invoert en weg wilt schrijven naar een ander tabblad. Maar waarom dan naa de bovenste rij en niet toevoegen aan het einde?

Of zie ik het verkeerd? Doe anders 's een voorbeeldbestand met meerdere dummyregels.

 

[Juser100]

De waarde is technisch gezien niet altijd uniek, echter kan en mag er niet meer dan één regel met 11... inkomen. Dat begrens ik laterna, maar eerst moet het wegschrijven (en evt. vervangen van bestaande waarden) fatsoenlijk werken. De waarde mag inderdaad ook aan het einde worden toegevoegd, maar ik weet niet hoe dit werkend te krijgen.

 

[Gert Bouwmeeste]

Doe even een voorbeeldbestand met ± 10 rijen op het blad waar weggeschreven moet worden.

 

[Juser100]

Zie de bijlage:

Bekijk bijlage zoeken-vervangen-waarden.xls

 

[Juser100]

Heeft iemand een idee hoe dit op te lossen is?

 

[Juser100]

??

 

[Roncancio]

Onderstaande macro zoekt de waarde van de A-kolom en vervangt de bijbehorende gegevens in de B-kolom.

Sub ZoekVervang()
With Worksheets(1)
    Set CD = Worksheets(2).Range("A:A").Find(.Range("A4").Value, , xlValues, xlWhole)
    If Not CD Is Nothing Then .Range("A4:G4").Copy Worksheets(2).Range("A" & CD.Row)
End With
End Sub

Met vriendelijke groet,


Roncancio

 

[Juser100]

Roncancio, dank voor je code.

Heb deze bijgevoegd bij datgene wat ik reeds heb. Probleem wat nu ontstaat is dat ik nu regels met dezelfde sleutelwaarde (cel A4 sheet1) kan toevoegen terwijl ik juist hiervoor die controle nodig heb. Ik wil in sheet2 enkel unieke sleutelwaarden weggeschreven hebben, indien de sleutelwaarde al op bestaat moet de betreffende regel in overschreven worden.

With Worksheets(1)
    Set Invoer = Worksheets(2).Range("A:A").Find(.Range("A4").Value, , xlValues, (xlWhole)
    If Not Invoer Is Nothing Then .Range("A4:G4").Copy Worksheets2).Range("A" & Invoer.Row)
End With

Worksheets(1).Select
If [H4] <> "X" Then GoTo data_invoer
Exit Sub
data_invoer:
    Worksheets(1).Range("A4:G4").Select
    Selection.Copy
    Worksheets(2).Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
    Selection.Font.ColorIndex = 0
    Selection.Interior.ColorIndex = xlNone
    Selection.FormatConditions.Delete
End Sub

Hoe krijg ik het voor elkaar dat de controle wordt uitgevoerd en op basis hiervan er een regel gewijzigd of toegevoegd wordt?

 

[Roncancio]

Volgens mij hoef je het 2e gedeelte van je code niet toe te voegen.
Mijn code zoekt naar de waarde van A4 en als deze gevonden wordt, dan worden de gevonden cellen overschreven.
Je hebt code toegevoegd die kijkt naar H4 en vervolgens gegevens in de 2e kolom van het andere werkblad plaatst.
Dat lijkt m.i. overbodig of je moet de controle van H4 ook in de zoekfunctie verwerken.

Met vriendelijke groet,


Roncancio