Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 11 van 11

Onderwerp: Hulp nodig voor code

  1. #1
    Junior Member
    Geregistreerd
    7 december 2017
    Vraag is opgelost

    Hulp nodig voor code

    Dag allemaal,
    Ik zou graag automatische code schrijven (in VBA) dat indien de waarde uit kolom A van tabblad "1" overeen komt met kolom A van tabblad "2" dan moeten de waarden uit de kolommen B, C en D (tabblad 2) van die rij gekopieerd worden naar het tabblad 1. De excel is uitgedunde versie, maar als het hier werk zal het voor mijn excel met 10000 lijnen ook wel werken. Ik doe dit liever niet manueel. Het excel bestand in bijlage zodat het probleem duidelijk is.
    Laatst aangepast door LDW : 22 januari 2018 om 14:47

  2. #2
    Mega Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Mij is het niet duidelijk. In de tab 'Betondekking' komt 18 keer 'FQ_00413010_003131.CSV' voor in kolom A. In de tab 'Resultaten' komt deze waarde 1 keer voor. Waarheen het gekopieerd moet worden staat ook nergens. Dus wat is de bedoeling?
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  3. #3
    Mega Senior
    Verenigingslid
    SjonR's avatar
    Geregistreerd
    10 november 2016
    Locatie
    Zaandam
    Afstand tot server
    ±116 km
    zoiets?

    Code:
    Sub sjon()
    Application.ScreenUpdating = False
        For Each cl In Sheets("Betondekking").Range("A2:A250")
            If Application.CountIf(Sheets("Resultaten").Range("A2:A500"), cl.Value) Then
                cl.Offset(, 3).Value = Sheets("Resultaten").Range("A2:A500").Find(cl.Value).Offset(, 1).Value
                cl.Offset(, 4).Value = Sheets("Resultaten").Range("A2:A500").Find(cl.Value).Offset(, 2).Value
                cl.Offset(, 5).Value = Sheets("Resultaten").Range("A2:A500").Find(cl.Value).Offset(, 3).Value
            End If
        Next cl
    Application.ScreenUpdating = True
    End Sub

  4. #4
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Ik dacht meer aan dit.
    Zie tabblad betondekking en na de code zie blad1 (lijkt mij dan identiek aan 'betondekking' in het voorbeeldbestand op kolom 3 na).
    Attached Files Attached Files
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  5. #5
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Zo bedoel je?

    Code:
    Sub hsv()
    Dim sv, hs, i As Long, ii As Long, zoek
    Application.ScreenUpdating = False
    sv = Sheets("resultaten").Cells(1).CurrentRegion
    With Sheets("betondekking").ListObjects(1)
    .Range.AutoFilter 3
     hs = .DataBodyRange.Value
        For i = 2 To UBound(sv)
         zoek = Application.Match(Split(sv(i, 1), "/")(1), .Range.Columns(1), 0)
            If Not IsError(zoek) Then
              For ii = zoek To zoek + sv(i, 5) - 1
                 hs(ii, 4) = sv(i, 2)
                 hs(ii, 5) = sv(i, 3)
                 hs(ii, 6) = sv(i, 4)
              Next ii
            End If
        Next i
     .DataBodyRange.Value = hs
     .Range.AutoFilter 3, "<>"
    End With
    End Sub
    Nb. druk op de reageerknop i.p.v. de citeerknop!
    De berichten hoef ik niet opnieuw te lezen, ik heb ze immers zelf geschreven.
    Laatst aangepast door HSV : 8 december 2017 om 19:39
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  6. #6
    Moet dit er ook nog niet ergens tussen?
    Code:
    Application.ScreenUpdating = true
    Het leven is geen krentebol.
    Life is like a box of chocolates, lastig als je op dieet bent.

  7. #7
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Nee, gaat automatisch.
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  8. #8
    Ok dat wist ik niet , dat is wel handig. Weer wat geleerd.
    Het leven is geen krentebol.
    Life is like a box of chocolates, lastig als je op dieet bent.

  9. #9
    Junior Member
    Geregistreerd
    7 december 2017
    Het werkt, bedankt!

  10. #10
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    Lijkt me lastig: VBA in een xlsx bestand.

    In een .xlsb bestand:

    Code:
    Sub M_snb()
      sn = Sheets("Betondekking").ListObjects(1).DataBodyRange.Resize(, 5)
      sp = Sheets("resultaten").Cells(1).CurrentRegion
       
      With CreateObject("scripting.dictionary")
        For j = 2 To UBound(sp) - 3
          .Item(Split(sp(j, 1), "/")(1)) = Array(sp(j, 2), sp(j, 3))
        Next
          
        For j = 1 To UBound(sn)
          st = .Item(sn(j, 1))
          sn(j, 4) = st(0)
          sn(j, 5) = st(1)
        Next
      End With
       
      Sheets("Betondekking").ListObjects(1).DataBodyRange.Resize(, 5) = sn
    End Sub
    Laatst aangepast door snb : 22 januari 2018 om 13:19
    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.

  11. #11
    Mega Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Waar is bericht van ± 10:20 uur gebleven?
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  12. Dit topic is automatisch gesloten omdat er sinds vier maanden niet meer op gereageerd is.

    Indien gewenst kan de topicstarter een verzoek tot heropening indienen.

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
Aanbiedingen