Hulp verticaal zoeken met VBA

Status
Niet open voor verdere reacties.
R

Raiden1

Gebruiker
Lid geworden
28 mrt 2019
Berichten
27
Goedemiddag allen,

Ik ben enige tijd bezig met VBA - verticaalzoeken, maar het lukt mij niet helemaal.
Ik heb een beetje hulp gehad van een kennis, maar daar komen wij ook niet uit.

Book1 zit in een andere map en book2 zit in een andere map op mijn laptop (zie book1 en book2 als bijlage).

wat gaat niet goed;
de juiste gegevens worden niet meegenomen uit book2 naar book1 als de ordernummers in kolomA van book1 van regels veranderen.

wat moet er gebeuren:
Uit book2 vanaf kolom B moeten alle gegevens overgenomen worden naar book1 vanaf kolom X met de volgende voorwaarden:
- Kolom A(ordernummer) uit book1 is referentie. Als het ordernummer van regel veranderd in book1, dan moeten de gegevens uit book2 vanaf kolom B ook naar de juste regel geplaatst worden in
book1 vanaf kolom X.

- Dit gebeurd vanaf regel 12 naar beneden toe (zie bijlage).

Code:
De VBA code vind je in de bijlage van het excel bestand book1

het lukt mij niet op hier te plaatsten.

hoop echt dat iemand mij hierbij kan helpen.


mvg
Nawien
 

Bijlagen

  • book1.xlsm
    23,3 KB · Weergaven: 34
  • book2.xlsm
    17,3 KB · Weergaven: 32
Je waarden in kolom A in Book2 zijn geen echte getallen.
Door in elke cel te gaan staan met F2 en dan Enter is het een getal.

Dat heb ik niet gedaan, maar een stukje code toegevoegd zodat Excel het wel ziet als getallen.

Code: 
Sub Upload()
Application.ScreenUpdating = False


  ' constants
  Const book2Name = "book2.xlsm"
  ' declarations
  Dim book2 As Worksheet
  Dim Wb1
  Dim Wb2
  Dim r
  Dim i As Long
  Dim J As Long
  ' start
     Workbooks.Open Filename:= _
        "C:\Users\762936\Desktop\Test bestanden\Test Doc\book2.xlsm", _
        UpdateLinks:=3
  
  Set book2 = ActiveWorkbook.Sheets(1)
  With ThisWorkbook.Sheets(1).Cells(11, 1).CurrentRegion.Resize(, 67)
  Wb1 = .Value
  Wb2 = book2.Cells(11, 1).CurrentRegion
   book2.Cells(11, 1).CurrentRegion.Columns(1).Value = book2.Cells(11, 1).CurrentRegion.Columns(1).Value
    For i = 2 To UBound(Wb1)
     r = Application.Match(Wb1(i, 1), book2.Columns(1), 0)
        If IsNumeric(r) Then
          For J = 24 To UBound(Wb2, 2)
            Wb1(i, J - 22) = Wb2(r - 10, J)
          Next J
        End If
    Next i
 .Value = Wb1
 End With
 Workbooks(book2Name).Close 0
MsgBox "Done"
End Sub
 
Querytable in Book1 naar book2 ?
 
HSV zei:
Je waarden in kolom A in Book2 zijn geen echte getallen.
Door in elke cel te gaan staan met F2 en dan Enter is het een getal.

Dat heb ik niet gedaan, maar een stukje code toegevoegd zodat Excel het wel ziet als getallen.

Code: 
Sub Upload()
Application.ScreenUpdating = False


  ' constants
  Const book2Name = "book2.xlsm"
  ' declarations
  Dim book2 As Worksheet
  Dim Wb1
  Dim Wb2
  Dim r
  Dim i As Long
  Dim J As Long
  ' start
     Workbooks.Open Filename:= _
        "C:\Users\762936\Desktop\Test bestanden\Test Doc\book2.xlsm", _
        UpdateLinks:=3
  
  Set book2 = ActiveWorkbook.Sheets(1)
  With ThisWorkbook.Sheets(1).Cells(11, 1).CurrentRegion.Resize(, 67)
  Wb1 = .Value
  Wb2 = book2.Cells(11, 1).CurrentRegion
   book2.Cells(11, 1).CurrentRegion.Columns(1).Value = book2.Cells(11, 1).CurrentRegion.Columns(1).Value
    For i = 2 To UBound(Wb1)
     r = Application.Match(Wb1(i, 1), book2.Columns(1), 0)
        If IsNumeric(r) Then
          For J = 24 To UBound(Wb2, 2)
            Wb1(i, J - 22) = Wb2(r - 10, J)
          Next J
        End If
    Next i
 .Value = Wb1
 End With
 Workbooks(book2Name).Close 0
MsgBox "Done"
End Sub
Klik om te vergroten...

Hallo Harry,

super dank voor je snelle oplossing, alleen is er dit nu aan de hand:

- De code kopieert de gegevens uit book2 vanaf kolom X en dit moet vanaf kolom B
- en in book1: de zelf gegevens plaatsten vanaf kolom X

ik probeer dit zelf te fixen maar tot nu toe niet gelukt.
voor derest werkt het prefect.

nogmaals super dank.

gr
Nawien
 
Rood stukje.

Code: 
If IsNumeric(r) Then
[COLOR=#ff0000]          For J = 2 To UBound(Wb2, 2)[/COLOR]
[COLOR=#ff0000]            Wb1(i, J + 22) = Wb2(r - 10, J)[/COLOR]
          Next J
        End If
 
HSV zei:
Rood stukje.

Code: 
If IsNumeric(r) Then
[COLOR=#ff0000]          For J = 2 To UBound(Wb2, 2)[/COLOR]
[COLOR=#ff0000]            Wb1(i, J + 22) = Wb2(r - 10, J)[/COLOR]
          Next J
        End If
Klik om te vergroten...


Hi Harry,

Super dank je wel!!
het werkt goed.
Je bent super geweldig

gr
Nawien
 
HSV zei:
Rood stukje.

Code: 
If IsNumeric(r) Then
[COLOR=#ff0000]          For J = 2 To UBound(Wb2, 2)[/COLOR]
[COLOR=#ff0000]            Wb1(i, J + 22) = Wb2(r - 10, J)[/COLOR]
          Next J
        End If
Klik om te vergroten...



HI Harry,

ik heb de booknamen veranderd (zie code hieronder) en ik kreeg aantal foutmeldingen. ik heb ze kunnen oplossen op 1 na en dat is de " .value= wb1 "

Book1 heet nu Dashboard
Book2 heet nu Database Team Nawien Wes

wat doe ik hier fout? zou je mij hierbij kunnen helpen?


Code: 
 Application.ScreenUpdating = False


  ' constants
  Const book2Name = "Database Team Nawien West.xlsm"
  ' declarations
  Dim book2 As Worksheet
  Dim wb1
  Dim Wb2
  Dim r
  Dim i As Long
  Dim J As Long
 
  ' start
     Workbooks.Open Filename:= _
        "S:\Nawien\Database\Database Team Nawien West.xlsm", _
        UpdateLinks:=3
  
  Set book2 = ActiveWorkbook.Sheets(1)
  With ThisWorkbook.Sheets("Projectenlijst").Cells(12, 1).CurrentRegion.Resize(, 67)
  wb1 = .Value
  Wb2 = book2.Cells(12, 1).CurrentRegion
   book2.Cells(12, 1).CurrentRegion.Columns(1).Value = book2.Cells(12, 1).CurrentRegion.Columns(1).Value
    For i = 2 To UBound(wb1)
     r = Application.Match(wb1(i, 1), book2.Columns(1), 0)
        If IsNumeric(r) Then
          For J = 2 To UBound(Wb2, 2)
            wb1(i, J + 22) = Wb2(r - 10, J)

          Next J
        End If
    Next i
 [COLOR="#FF0000"].Value = wb1
[/COLOR] End With
 Workbooks(book2Name).Close 0
MsgBox "Done"
 
Laatst bewerkt:
Hallo Nawien,

De grootste fout is je lege rijen bovenaan je blad.
Zonder die lege rijen worden codes veel eenvoudiger geschreven.

Geen idee waar het fout gaat. maar wat is de waarde van.
Code: 
[COLOR=#3E3E3E]wb1 = .Value
[/COLOR][COLOR=#ff0000]msgbox Ubound(wb1) & " | " & Ubound(wb1,2) [/COLOR]
[COLOR=#3E3E3E]Wb2 = book2.Cells(12, 1).CurrentRegion[/COLOR]

Ook zal je deze moeten aanpassen.
Code: 
[COLOR=#3E3E3E]wb1(i, J + 22) = Wb2(r - 10, J)[/COLOR]
In:
Code: 
[COLOR=#3E3E3E]wb1(i, J + 22) = Wb2(r - [/COLOR][COLOR=#ff0000]11[/COLOR][COLOR=#3E3E3E], J)[/COLOR]
Maar dat is koffiedik kijken waar je wel of niet start in het blad.
 
HSV zei:
Hallo Nawien,

De grootste fout is je lege rijen bovenaan je blad.
Zonder die lege rijen worden codes veel eenvoudiger geschreven.

Geen idee waar het fout gaat. maar wat is de waarde van.
Code: 
[COLOR=#3E3E3E]wb1 = .Value
[/COLOR][COLOR=#ff0000]msgbox Ubound(wb1) & " | " & Ubound(wb1,2) [/COLOR]
[COLOR=#3E3E3E]Wb2 = book2.Cells(12, 1).CurrentRegion[/COLOR]

Ook zal je deze moeten aanpassen.
Code: 
[COLOR=#3E3E3E]wb1(i, J + 22) = Wb2(r - 10, J)[/COLOR]
In:
Code: 
[COLOR=#3E3E3E]wb1(i, J + 22) = Wb2(r - [/COLOR][COLOR=#ff0000]11[/COLOR][COLOR=#3E3E3E], J)[/COLOR]
Maar dat is koffiedik kijken waar je wel of niet start in het blad.
Klik om te vergroten...


ow ok,

wat ik zo raar vind is, dat de aangepaste code het goed en neemt ook alles over en dan op t einde geeft ie deze foutmelding.
gisteren geprobeerd op te lossen maar lukt niet.
VBA foutmelding.JPG
 
Wat is het resultaat van de MsgBox?
 
Haal je de gegevens uit het eerste blad van het tweede boek?
Wat is de waarde van:

Code: 
 [COLOR=#333333]Wb2 = book2.Cells(12, 1).CurrentRegion
[/COLOR][COLOR=#ff0000]msgbox Ubound(wb2) & " | " & ubound(wb2,2)[/COLOR][COLOR=#333333][/COLOR]
[COLOR=#3E3E3E]book2.Cells(12, 1).CurrentRegion.Columns(1).Value = book2.Cells(12, 1).CurrentRegion.Columns(1).Value[/COLOR][COLOR=#333333]
[/COLOR]
 
HSV zei:
Haal je de gegevens uit het eerste blad van het tweede boek?
Wat is de waarde van:

Code: 
 [COLOR=#333333]Wb2 = book2.Cells(12, 1).CurrentRegion
[/COLOR][COLOR=#ff0000]msgbox Ubound(wb2) & " | " & ubound(wb2,2)[/COLOR][COLOR=#333333][/COLOR]
[COLOR=#3E3E3E]book2.Cells(12, 1).CurrentRegion.Columns(1).Value = book2.Cells(12, 1).CurrentRegion.Columns(1).Value[/COLOR][COLOR=#333333]
[/COLOR]
Klik om te vergroten...

Dat klopt. het 2de book heeft alleen maar 1 blad en derest heb ik vewijderd.
 
Is het een 1 of een kleine L?
Wb1
Wbeen of WbL ?
 
Plaats beide bestanden nog eens met die veranderingen.
 
Zet de rode tekst eens bovenaan en kijk wat er fout gaat.
Code: 
[COLOR=#ff0000]Option Explicit[/COLOR]
Sub Upload()




Application.ScreenUpdating = False
 
HSV zei:
Zet de rode tekst eens bovenaan en kijk wat er fout gaat.
Code: 
[COLOR=#ff0000]Option Explicit[/COLOR]
Sub Upload()




Application.ScreenUpdating = False
Klik om te vergroten...

Gedaan en nogsteeds zelfde foutmelding

kan de bestanden als prive bericht versturen?
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan