Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Pagina 1 van 2 1 2 LaatsteLaatste
Weergeven resultaten 1 tot 20 van 33

Onderwerp: omzetten naar waarde en opschuiven

  1. #1
    Member
    Geregistreerd
    3 september 2021
    Vraag is opgelost

    omzetten naar waarde en opschuiven

    Ik heb een hele lijst met Functies en hele lijst met Toegang tot opties, hier heb ik even een klein voorbeeld toegevoegd ipv de hele lijst.

    Zie bijlage
    Huidige input: LINKS
    Wenselijke output: RECHTS

    Na het uitvoeren van de macro (vba) zijn de volgende acties wenselijk:
    1) Indien er een kruisje staat moet hier de Toegang code (rij A)
    2) Alle waarden moeten opgeschoven worden en aansluitend na kolom B.
    Bijgevoegde bestanden Bijgevoegde bestanden

  2. #2
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Je voorbeeld bestand bevat geen macro's.
    "It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
    Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
    Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5

  3. #3
    Giga Honourable Senior Member
    Verenigingslid
    snb's avatar
    Geregistreerd
    12 juni 2008
    Verzorgt NCOI geen Excel-cursussen in Drachten ?

    In L6:
    PHP Code:
    1
    
    =INDEX($C$1:$G$1;MATCH("X";C6:G6;0))
    In M6:
    PHP Code:
    1
    
    =IFERROR(INDEX($C$1:$G$1;;MATCH("X";OFFSET(C6:G6;;MATCH("X";C6:G6;0));0)+MATCH("X";C6:G6;0));"")
    Laatst aangepast door snb : 3 september 2021 om 11:58
    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.

  4. #4
    Member
    Geregistreerd
    3 september 2021
    Heb ook even een xlsm toegevoegd.
    Bijgevoegde bestanden Bijgevoegde bestanden

  5. #5
    Giga Honourable Senior Member
    Verenigingslid
    snb's avatar
    Geregistreerd
    12 juni 2008
    Heb je de formules al toegepast ?
    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.

  6. #6
    Member
    Geregistreerd
    3 september 2021
    daar ben ik dus naar op zoek hoe je dit via een formule of code kunt omzetten van X naar de code + daarnaast lege cellen verwijderen op een rij.
    Laatst aangepast door HJ1 : 3 september 2021 om 13:23

  7. #7
    Giga Senior Haije's avatar
    Geregistreerd
    24 maart 2009
    Locatie
    Oldenzaal
    HJ1,

    in deze bijlage staan de formules van SNB zoals ze in het NL zijn
    Bijgevoegde bestanden Bijgevoegde bestanden
    Haije
    ___________________________________________________

  8. #8
    Giga Honourable Senior Member
    Verenigingslid
    snb's avatar
    Geregistreerd
    12 juni 2008
    Iets geavanceerder; in L6 de matrix-formule:

    PHP Code:
    1
    
    =IFERROR(INDEX($C$1:$G$1;;SMALL(IF($C6:$G6="X";COLUMN($A1:$E1));COLUMN(A1)));"")

    doortrekken naar rij 16, en kolom P
    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.

  9. #9
    Member
    Geregistreerd
    3 september 2021
    Helaas worden de lege cellen niet verwijderd, ondanks dat de cel leeg is ziet Excel toch nog een kenmerk dat het veld niet verwijderd wordt.

    Ik heb namelijk een stamdata werkklad "Invulblad".
    1) Mijn eerste actie die ik doe is een kopie maken van mijn Invulblad en deze plak ik in mijn werkblad "Export".
    2) Via VBA vul ik cel B1 vul met deze formule

    =ALS(Invulblad!C6="X";Invulblad!C$1;"")
    ActiveCell.FormulaR1C1 = "=IF(Invulblad!RC=""X"",Invulblad!R1C,"""")"

    3) Deze kopieer ik na alle velden (in dit geval B1 t/m AT39 (ik wil eigenlijk met een variabele code doen maar die krijg ik niet werkende (de kolom en laatst cel wil niet)

    Alle velden zijn nu gevuld met de gewenste code.
    4) Daarna wil ik alle formules uit het werkblad halen zodat alle lege cellen ook worden herkend, dit dacht ik te doen door Kopiëren -> plakken speciaal "als waarden".
    5) Selecteren lege cellen, wanneer ik alle cellen selecteer en F5 (ga naar) > speciaal > lege waarden ; dan worden toch alle lege cellen niet geselecteerd...en kan ik ze dus ook niet verwijderen.

    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlToLeft
    Bijgevoegde bestanden Bijgevoegde bestanden

  10. #10
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Je kan alle formules naar waarden converteren als volgt:
    Code:
    For Each cl In Range(ActiveSheet.UsedRange.Address).SpecialCells(xlCellTypeFormulas)
       cl.Formula = cl.Value
    Next cl
    Dan werkt je F5 actie wel zoals gewenst.
    Geen idee wat er dan in je voorbeeld document nog met E1 aan de hand is.
    Laatst aangepast door edmoor : 6 september 2021 om 13:22
    "It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
    Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
    Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5

  11. #11
    Member
    Geregistreerd
    3 september 2021
    Top.
    Dit werkt.
    Laatst aangepast door HJ1 : 6 september 2021 om 13:28

  12. #12
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Kan toch in 1 keer met VBA?

    Code:
    Sub VenA()
      ar = Sheets("Invulblad").UsedRange
      Set d = CreateObject("Scripting.Dictionary")
      For j = 6 To UBound(ar)
        For jj = 3 To UBound(ar, 2)
          If LCase(ar(j, jj)) = "x" Then c00 = c00 & ar(1, jj) & "|"
        Next jj
        If Len(c00) Then
          d(ar(j, 2)) = ar(j, 2) & "|" & c00
          c00 = ""
        End If
      Next j
      
      With Sheets("Export")
        .Cells.Clear
        .Cells(1).Resize(d.Count) = Application.Transpose(d.items)
        .Columns(1).TextToColumns .Cells(1), xlDelimited, , False, False, False, False, False, True, "|"
      End With
    End Sub
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  13. #13
    Member
    Geregistreerd
    3 september 2021
    @VenA,
    Dit werkt inderdaad geniaal! Scheelt heel wat scripting :-D

    Kun je misschien het een en ander toelichten zodat ik ook een beetje weet wat wat doet...en dat ik het tzt vaker kan gaan toepassen.
    Thankx!

  14. #14
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    Een snellere methode dan texttocolumns.
    Code:
    Sub hsv()
      sv = Sheets("Invulblad").UsedRange
      ReDim b(UBound(sv) + 1)
      Set d = CreateObject("Scripting.Dictionary")
      For j = 6 To UBound(sv)
        For jj = 3 To UBound(sv, 2)
          If LCase(sv(j, jj)) = "x" Then
                a = d(sv(j, 2))
                  If IsEmpty(a) Then a = b
                     a(0) = sv(j, 2)
                     a(UBound(a)) = a(UBound(a)) + 1
                     a(a(UBound(a))) = sv(1, jj)
                d(sv(j, 2)) = a
               If x < a(UBound(a)) Then x = a(UBound(a))
              End If
            Next jj
         Next j
      With Sheets("Export")
        .Cells.Clear
        .Cells(1).Resize(d.Count, x + 1) = Application.Index(d.items, 0)
      End With
    End Sub
    ____________
    Met vriendelijke groet,
    Harry

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

  15. #15
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    ReDim b(UBound(sv, 2) + 1). Maar altijd leuk de combinatie van een dictionary met een array
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  16. #16
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    Juist, een foutje met grote gevolgen.
    Hierbij de aangepaste versie (zonder de x constructie)

    Code:
    Sub hsv()
      sv = Sheets("Invulblad").UsedRange
      ReDim b(UBound(sv, 2) + 1)
      Set d = CreateObject("Scripting.Dictionary")
      For j = 6 To UBound(sv)
        For jj = 3 To UBound(sv, 2)
          If LCase(sv(j, jj)) = "x" Then
               a = d(sv(j, 2))
                  If IsEmpty(a) Then a = b
                     a(0) = sv(j, 2)
                     a(UBound(a)) = a(UBound(a)) + 1
                     a(a(UBound(a))) = sv(1, jj)
               d(sv(j, 2)) = a
              End If
            Next jj
         Next j
       With Sheets("Export")
        .Cells.Clear
        .Cells(1).Resize(d.Count, UBound(sv, 2) - 1) = Application.Index(d.items, 0)
      End With
    End Sub
    ____________
    Met vriendelijke groet,
    Harry

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

  17. #17
    Giga Honourable Senior Member
    Verenigingslid
    snb's avatar
    Geregistreerd
    12 juni 2008
    Code:
    Sub M_snb()
      Application.ScreenUpdating = False
    
      sn = Blad1.Range("C1:Q1")
      For j = 1 To UBound(sn, 2)
        Blad1.Columns(2 + j).Replace "X", sn(1, j)
      Next
    
      Blad1.Cells(6, 2).CurrentRegion.Offset(, 1).Resize(, UBound(sn, 2) + 1).SpecialCells(4).Delete -4159
    End Sub
    Laatst aangepast door snb : 7 september 2021 om 12:02
    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.

  18. #18
    Member
    Geregistreerd
    3 september 2021
    Heb toch nog een kleine wens, nu worden alle cellen mooi opgeschoven maar eigenlijk zou ik deze cellen per rij in 1 cel willen hebben.
    Cel A1: Z-ADM01, AB10, AB13, etc.
    Cel A2: Z-ADM04, BB10, CC02, EE05, etc.


    Deze code beviel heb ik nu toegepast
    Code:
    Sub export_functie_groepen()
     sv = Sheets("Invulblad").UsedRange
      ReDim b(UBound(sv, 2) + 1)
      Set d = CreateObject("Scripting.Dictionary")
      For j = 6 To UBound(sv)
        For jj = 3 To UBound(sv, 2)
          If LCase(sv(j, jj)) = "x" Then
               a = d(sv(j, 2))
                  If IsEmpty(a) Then a = b
                     a(0) = sv(j, 2)
                     a(UBound(a)) = a(UBound(a)) + 1
                     a(a(UBound(a))) = sv(1, jj)
               d(sv(j, 2)) = a
              End If
            Next jj
         Next j
       With Sheets("Export")
        .Cells.Clear
        .Cells(1).Resize(d.Count, UBound(sv, 2) - 1) = Application.Index(d.items, 0)
      End With
    End Sub

  19. #19
    Giga Honourable Senior Member
    Verenigingslid
    snb's avatar
    Geregistreerd
    12 juni 2008
    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.

  20. #20
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Als je Excel 365 hebt dan kan het eenvoudig met deze formule
    PHP Code:
    1
    
    =IF(Invulblad!B6="";"";Invulblad!B6&", "&TEXTJOIN(", ";;IF(Invulblad!C6:Q6="x";Invulblad!$C$1:$Q$1;"")))
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

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

Regels
Help

Helpmij.nl en business

Partners
Sponsoren