Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Weergeven resultaten 1 tot 5 van 5

Onderwerp: Private Sub CommandButton1_Click() doorlussen

  1. #1
    Senior Member
    Geregistreerd
    3 juli 2009
    Locatie
    venray
    Vraag is niet opgelost

    Private Sub CommandButton1_Click() doorlussen

    Graag wil ik met 1 macro button 2 bestanden inlezen op verschillende positie. mij is het niet gelukt om de onderstaande door te lussen. Heeft iemand een optie hoe je dit beste kan doen?

    Code:
    Private Sub CommandButton1_Click()
      c00 = ThisWorkbook.Path & "\Productie ok.xls"
      With GetObject(c00)
        ar = .Sheets(1).Cells(1).CurrentRegion
        .Close 0
      End With
      
      y = Application.Transpose(Application.Index(ar, 0, 1))
      ar1 = Sheets("ok").Cells(3, 1).CurrentRegion.Resize(, 19)
    
      For j = 2 To UBound(ar1)
        x = Application.Match(ar1(j, 1), y, 0)
        If IsNumeric(x) Then
          For jj = 2 To 19
            ar1(j, jj) = ar(x, jj)
          Next jj
        End If
      Next j
      Sheets("ok").Cells(3, 1).CurrentRegion.Resize(, 19) = ar1
    End With
    
    
    
    
    c00 = ThisWorkbook.Path & "\Productie ok1.xls"
      With GetObject(c00)
        ar = .Sheets(1).Cells(1).CurrentRegion
        .Close 0
      End With
      
      y = Application.Transpose(Application.Index(ar, 0, 1))
      ar1 = Sheets("ok").Cells(34, 1).CurrentRegion.Resize(, 19)
    
      For j = 2 To UBound(ar1)
        x = Application.Match(ar1(j, 1), y, 0)
        If IsNumeric(x) Then
          For jj = 2 To 19
            ar1(j, jj) = ar(x, jj)
          Next jj
        End If
      Next j
      Sheets("ok").Cells(34, 1).CurrentRegion.Resize(, 19) = ar1
    End If
    
    End Sub
    Laatst aangepast door huijb : 19 september 2023 om 16:03

  2. #2
    Giga Honourable Senior Member
    Verenigingslid
    snb's avatar
    Geregistreerd
    12 juni 2008
    Je code is leesbaarder als je de juiste code tags gebruikt #
    VBA voor smarties
    VBA is een taal die je moet leren met een grammatica- en een woordenboek.

    http://www.helpmij.nl/forum/announcement.php?f=5
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

  3. #3
    Tera Honourable Senior Member
    Verenigingslid
    OctaFish's avatar
    Geregistreerd
    6 februari 2009
    Locatie
    Rotterdam
    En als je naar je code kijkt, zie je dat regel 20 overbodig is, en regel 43 ook. Dus de procedure gaat sowieso niet werken.
    Gebruik de QUOTE knop alleen als je iets wit citeren.
    Op deze pagina kun je zien hoe je met TAGS werkt.

  4. #4
    Senior Member
    Geregistreerd
    3 juli 2009
    Locatie
    venray
    ik heb met call alle excel documenten ingelezen.

    nog ander idee?



    Code:
    Private Sub CommandButton1_Click()
    
    Call CommandButton2_Click
    Call CommandButton3_Click
    Call CommandButton4_Click
    
    
    End Sub
    
    
    Private Sub CommandButton2_Click()
      c00 = ThisWorkbook.Path & "\ok1.xls"
      With GetObject(c00)
        ar = .Sheets(1).Cells(1).CurrentRegion
        .Close 0
      End With
      
      y = Application.Transpose(Application.Index(ar, 0, 1))
      ar1 = Sheets("ok").Cells(11, 1).CurrentRegion.Resize(, 16)
    
      For j = 2 To UBound(ar1)
        x = Application.Match(ar1(j, 1), y, 0)
        If IsNumeric(x) Then
          For jj = 2 To 16
            ar1(j, jj) = ar(x, jj)
          Next jj
        End If
      Next j
      Sheets("ok").Cells(11, 1).CurrentRegion.Resize(, 16) = ar1
    End Sub
    
    
    
    
    Private Sub CommandButton3_Click()
    c00 = ThisWorkbook.Path & "\ok2.xls"
      With GetObject(c00)
        ar = .Sheets(1).Cells(1).CurrentRegion
        .Close 0
      End With
      
      y = Application.Transpose(Application.Index(ar, 0, 1))
      ar1 = Sheets("ok").Cells(11, 18).CurrentRegion.Resize(, 16)
    
      For j = 2 To UBound(ar1)
        x = Application.Match(ar1(j, 1), y, 0)
        If IsNumeric(x) Then
          For jj = 2 To 16
            ar1(j, jj) = ar(x, jj)
          Next jj
        End If
      Next j
      Sheets("ok").Cells(11, 18).CurrentRegion.Resize(, 16) = ar1
    End Sub
    
    
    Private Sub CommandButton4_Click()
    c00 = ThisWorkbook.Path & "\ok3.xls"
      With GetObject(c00)
        ar = .Sheets(1).Cells(1).CurrentRegion
        .Close 0
      End With
      
      y = Application.Transpose(Application.Index(ar, 0, 1))
      ar1 = Sheets("ok").Cells(11, 35).CurrentRegion.Resize(, 16)
    
      For j = 2 To UBound(ar1)
        x = Application.Match(ar1(j, 1), y, 0)
        If IsNumeric(x) Then
          For jj = 2 To 16
            ar1(j, jj) = ar(x, jj)
          Next jj
        End If
      Next j
      Sheets("ok").Cells(11, 35).CurrentRegion.Resize(, 16) = ar1
    End Sub
    Laatst aangepast door huijb : 19 september 2023 om 18:30

  5. #5
    Giga Honourable Senior Member
    Verenigingslid
    snb's avatar
    Geregistreerd
    12 juni 2008
    Geef eens een voorbeeld van een uit te lezen bestand en het betand waarin die gegevens terecht moeten komen.

    Het kan natuurlijk in een lus for j=1 to 3 in plaats van 3 knoppen.
    VBA voor smarties
    VBA is een taal die je moet leren met een grammatica- en een woordenboek.

    http://www.helpmij.nl/forum/announcement.php?f=5
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren