Help!

PC-Problemen?
De vrijwilligers van Oplossing.be zoeken gratis met u mee!

Hulp bij posten

Recente topics

Auteur Topic: Jaartallen aanvullen  (gelezen 275 keer)

0 leden en 1 gast bekijken dit topic.

Offline Veerj

  • Volledig lid
  • **
  • Berichten: 192
Jaartallen aanvullen
« Gepost op: 23 september 2021, 21:37:22 »
Avond!

Een leuke puzzel voor geïnteresseerden :):

In kolom A staan jaartallen, gescheiden door komma's en hoge streepjes.
Wanneer jaartallen gescheiden zijn dmv een streepje, betekent het dat ik de tussenliggende jaartallen ook wil ophalen. Een range van jaren zegmaar.

Het voorbeeldbestand maakt het wel duidelijk. Vanaf kolom B zie je de gewenste output.




Offline RedHead

  • Excel-Expert
  • Ambassadeur
  • *****
  • Berichten: 2.163
  • Geslacht: Man
  • Met Excel lukt 't wel.... (toch???)
Re: Jaartallen aanvullen
« Reactie #1 Gepost op: 23 september 2021, 23:01:55 »
Veerj, als ff een snelle uitwerking op je queste van deze week, heb ik dit bedacht....
Sub JaartalLijsten()

    Overzicht = ActiveSheet.Cells(1).CurrentRegion
    ReDim OverzichtOutput(1 To UBound(Overzicht, 1), 1 To 1)
   
    For i = 1 To UBound(Overzicht, 1)
        For ii = 0 To UBound(Split(Overzicht(i, 1), ", "))
            If InStr(1, Split(Overzicht(i, 1), ", ")(ii), "-") > 0 Then ' waarde bevat een minnetje
                For iii = Split(Split(Overzicht(i, 1), ", ")(ii), "-")(0) To Split(Split(Overzicht(i, 1), ", ")(ii), "-")(1)
                    OverzichtOutput(i, 1) = OverzichtOutput(i, 1) & "," & iii
                Next iii
            Else
                OverzichtOutput(i, 1) = OverzichtOutput(i, 1) & "," & Split(Overzicht(i, 1), ", ")(ii)
            End If
        Next ii
    Next i
   
    With ActiveSheet.Cells(1, 2).Resize(UBound(Overzicht, 1))
        .Value = OverzichtOutput
        .TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, Comma:=True
        .EntireColumn.Delete
    End With
   
End Sub
______________________________

Groet, Leo

Offline Veerj

  • Volledig lid
  • **
  • Berichten: 192
Re: Jaartallen aanvullen
« Reactie #2 Gepost op: 24 september 2021, 08:19:38 »
Mooie oplossing Leo! :)

Edti: Om je nog eens uit te dagen 8), je kunt alles in een array lezen en in één klap wegschrijven.
« Laatst bewerkt op: 24 september 2021, 08:35:04 door Veerj »

Offline Warme bakkertje

  • Excel-Expert
  • Volledig lid
  • *****
  • Berichten: 136
  • Geslacht: Man
Re: Jaartallen aanvullen
« Reactie #3 Gepost op: 24 september 2021, 15:18:38 »
Veerj,

Ik weet niet of je dit echt winst gaat opleveren aangezien TextToColumns ook supersnel is.

Het enige wat ik zou veranderen om die extra loop te vermijden bij getal-getal is door dit blokje

                For iii = Split(Split(Overzicht(i, 1), ", ")(ii), "-")(0) To Split(Split(Overzicht(i, 1), ", ")(ii), "-")(1)
                    OverzichtOutput(i, 1) = OverzichtOutput(i, 1) & "," & iii
                Next iii

te wijzigen in dit blokje

                st = Split(Split(Overzicht(i, 1), ", ")(ii), "-")(0): et = Split(Split(Overzicht(i, 1), ", ")(ii), "-")(1)
                OverzichtOutput(i, 1) = OverzichtOutput(i, 1) & "," & Join(Application.Transpose(Evaluate("row(" & st & ":" & et & ")")), ",")

maar dit is meer cosmetica dan dat het supergrote tijdswinst zal opleveren.
Windows 10 Home   NLD 64bit

Microsoft Office Professional Plus 2016 US

Offline Veerj

  • Volledig lid
  • **
  • Berichten: 192
Re: Jaartallen aanvullen
« Reactie #4 Gepost op: 24 september 2021, 17:28:15 »
Inderdaad, de snelheid van tekst naar kolommen heb ik onderschat! Op 2000 regels maakt het geen verschil qua snelheid.

Sub jvr()
 jv = Cells(1, 1).CurrentRegion
 ReDim ar(1 To UBound(jv), 1 To 100)
 
 For j = 1 To UBound(jv)
   c00 = Split(jv(j, 1), ", "): x = 0
    For Each it In c00
       y = Split(it, "-")
        For i = y(0) To y(UBound(y))
           x = x + 1
           ar(j, x) = i
        Next
     Next
 Next
 
 Cells(1, 2).Resize(UBound(ar), UBound(ar, 2)) = ar
End Sub

 


www.combell.com