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
    Vraag is niet opgelost

    Hulp nodig voor code

    Dag allemaal,
    Ik zou graag automatische code schrijven (in VBA) dat indien de waarde uit kolom A van tabblad "Betondekking" overeen komt met kolom A van tabblad "Resultaten" dan moeten de waarden uit de kolommen B, C en D (tabblad resultaten) van die rij gekopieerd worden naar het tabblad betondekking. 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.

    Betondekkingen NZ test.xlsm

    Bedankt alvast!

  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

    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
    Niemand is slim genoeg om zijn eigen domheid te bevatten!

    Wanneer een vraag is opgelost, markeer het dan a.u.b. ook als opgelost!

  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
    Quote Origineel gepost door VenA Bekijk Bericht
    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?
    Excuses voor de gebrekkige uitleg, maar lijkt allemaal vanzelfsprekend als je ermee bezig bent.
    Een voorbeeld: In het tabblad resultaten is cel A2 gelijk aan "PRJ_16026 Kolommen en muren/FQ_00413010_003131.CSV", in het tabblad betondekking staat in cel A2 "FQ_00413010_003131.CSV" wat dus gedeeltelijk overeenkomt met cel A2 vab het tabblad resultaten. Voor iedere keer dat dit voorkomt op het tabblad Betondekking, moet dit gezocht worden in het tabblad Resultaten en vervolgens moeten de kolommen B, C en D van het tabblad resultaten gekopieerd worden naar de kolommen D, E en F van tabblad betondekking. Resultaten bevat een samenvatting, in betondekking is dit opgesplitst in 17 metingen, maar de kolommen die gekopieerd moeten worden zijn telkens gelijk (is gelinkt aan de waarde in kolom A). Hopelijk is dit iets duidelijker? In bijlage nog eens het volledige bestand dat gedeeltelijk al manueel is ingevuld.

    Startbestand.xlsx

  6. #6
    Quote Origineel gepost door HSV Bekijk Bericht
    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).
    Ik zou wel alles in kolomo B en C van het tabblad betondekking moeten kunnen bewaren? Dus het tabblad Betondekking moet aangevuld worden..

  7. #7
    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 20:39
    ____________
    mvg,
    Harry

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

  8. #8
    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.

  9. #9
    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)

  10. #10
    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.

  11. #11
    Het werkt, bedankt!

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