• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA verticaal zoeken, geef verkeerde waarde

Status
Niet open voor verdere reacties.
HWV

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.183
Beste,

Ik gebruik verticaal zoeken al een tijd je maar met dit bestand wil het mij niet lukken.
Hij geef als hij geen waarde kan vinden de waarde van bovenliggende cel.

Hoe kan ik dit oplossen:

Code: 
Sub verticaalZoeken()

On Error Resume Next
    For j = 4 To Sheets("Registratie").Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Import").Columns(1).Find(Sheets("Registratie").Cells(j, 1).Value)
      .Offset(, 10).Copy
      Sheets("Registratie").Cells(j, 11).PasteSpecial xlPasteValues
    End With
  Next
End Sub

Bekijk bijlage Helpmij verticaalzoeken.xlsm

Alvast dank voor de aangeboden hulp.

HWV
 
Oplossing al gevonden

Beste,

Ik heb het opgelost met onderstaande!

Code: 
Sub Testing()

Dim DRACCT As String
Dim DR24 As Variant
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Lastrow As Long
Dim i As Long

Lastrow = Range("A20000").End(xlUp).Row

Set sh1 = ThisWorkbook.Worksheets("Registratie")
Set sh2 = ThisWorkbook.Worksheets("Import")

'On Error Resume Next

For i = 4 To Lastrow

    DRACCT = sh1.Cells(i, 1).Value
    DR24 = Application.VLookup(DRACCT, sh2.Range("A:K"), 11, False)

    If Not IsError(DR24) Then
    sh1.Cells(i, 11).Value = DR24

    Else ' do nothing
    End If

Next i

End Sub

Groet HWV
 
Om het iets sneller te maken

Code: 
Sub VenA()
  ar = Sheets("Import").Cells(1).CurrentRegion
  With Sheets("Registratie").Cells(2, 1).CurrentRegion
    .Columns(11).Offset(1).ClearContents
    ar1 = .Value
    For j = 2 To UBound(ar)
      For jj = 2 To UBound(ar1)
        If ar(j, 1) = ar1(jj, 1) Then
          ar1(jj, 11) = ar(j, 11)
          Exit For
        End If
      Next jj
    Next j
    .Value = ar1
  End With
End Sub
 
Werkt weer geweldig

Beste,

Dit werkt goed, maar de vraag is nu ontstaan en of het mogelijk is dat weet ik niet.
Ik zou eigenlijk willen als er al een waarde is gevuld dus in dit geval de sheet "registratie",
dat hij dan de nieuwe tekst uit de sheet "import" samenvoegt en de sheet "registratie" op de te gevonden resultaat.

Ik werk nog niet met de opgave van V en A, omdat ik daar nog de melding krijg het valt buiten het script op de volgende regel:

Code: 
ar = Sheets("Import").Cells(1).CurrentRegion
  With Sheets("Registratie").Cells(2, 1).CurrentRegion

Alvast dank voor de aangeboden hulp.
 
Verwijder rij drie in registratie of pas de code aan.

Je foutmelding zal iets met je bladnaam van doen hebben.
Code: 
ar = Sheets("Import").Cells(1).CurrentRegion
  With Sheets("Registratie").Cells(2, 1).CurrentRegion
    .Columns(11).Offset(2).ClearContents
    ar1 = .Value
    For j = 2 To UBound(ar)
      For jj = 3 To UBound(ar1)
        If ar(j, 1) = ar1(jj, 1) Then
          ar1(jj, 11) = ar(j, 11)
          Exit For
        End If
      Next jj
    Next j
    .Value = ar1
  End With
 
stond idd map naam verkeerd

Ik heb de foutmelding gevonden, idd een sheetnaam die ik had veranderd :confused:
Dus dit werkt, wat ik nu niet snap waarom dit is toegevoegd:
Code: 
 .Columns(11).Offset(2).ClearContents

Deze code maak de hele rij leeg.
Maar wat ik wil is als er bv in de map registratie al een tekst staat
"hier staat een tekst" dat deze dan wordt samengevoegd met de zoekwaarde bv "Test 20180224_000" wat dan als uitslag geeft:

"hier staat een tekst Test 20180224_000"

Is dit mogelijk!


Bekijk bijlage Helpmij verticaalzoeken.xlsm
 
Onderstaande is ook tekst.

"Test 20180224_000"

dan wordt het:
"Test 20180224_000 Test 20180224_000"
 
Code: 
Sub VenA()
ar = Sheets("Import").Cells(1).CurrentRegion
  With Sheets("Registratie").Cells(2, 1).CurrentRegion
    ar1 = .Value
    For j = 2 To UBound(ar)
      For jj = 3 To UBound(ar1)
        If ar(j, 1) = ar1(jj, 1) Then
          ar1(jj, 11) = ar1(jj, 11) & " " & ar(j, 11)
          Exit For
        End If
      Next jj
    Next j
    .Value = ar1
  End With
End Sub
 
Code: 
ar = Sheets("Import").Cells(1).CurrentRegion
  With Sheets("Registratie").Cells(2, 1).CurrentRegion
    ar1 = .Value
    .Columns(11).Offset(2).ClearContents
    For j = 2 To UBound(ar)
      For jj = 3 To UBound(ar1)
        If ar(j, 1) = ar1(jj, 1) Then
        If InStr(ar1(jj, 11), ar(j, 1)) = 0 Then
             ar1(jj, 11) = ar1(jj, 11) & " " & ar(j, 11)
          Else
             ar1(jj, 11) = ar(j, 11)
         End If
          Exit For
        End If
      Next jj
    Next j
    .Value = ar1
  End With
 
Laatst bewerkt:
Geweldig geholpen

Beste,

Bedankt voor de hulp, ik heb het nu werkend in een nieuw bestand, want ik denk dat mijn oude registratie een beetje corrupt was geworden.
Ik heb nu geen problemen meer en alles werkt naar behoren.

Groet HWV.:thumb:
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan