Stel, je gegevens staan van links naar rechts, Oftewel horizontaal. Door middel van een dropdown en wat formules kun je specifieke gegevens ophalen en verticaal weergeven.
Invoeren met Ctrl+Shift+Enter. Niet alleen met Enter. Indien je dit correct doet, plaatst Excel accolades om de formule { } Let op ! ! ! Plaats die accolades niet zelf.
Invoeren met Ctrl+Shift+Enter. Niet alleen met Enter. Indien je dit correct doet, plaatst Excel accolades om de formule { } Let op ! ! ! Plaats die accolades niet zelf.
Je gegevens staan in het blauwe gedeelte en de twee velden, Start en Stop, bevatten een datumbereik. Nu wil je voor elke dag in het datumbereik een nieuwe rij creëren (het oranje gedeelte).
Zie het voorbeeld in de afbeelding.
1. Kopieer de onderstaande code 2. Open een nieuwe werkmap 3. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen 4. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen 5. Druk op M om een standaard module in te voegen 6. Daar waar de cursor knippert voeg je de code in middels Ctrl + V 7. Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel 8. Druk op de toetscombinatie ALT + F8 om de Macro Dialoog te tonen. Dubbeklik op de macro naam om te starten.
Option Explicit
Sub Een_Dag_Per_Rij()
Dim varData As Variant, varSplitData As Variant
Dim lngRijen As Long, lngRijTotaal As Long, x As Long
Dim y As Long, lngRij As Long, lngRijMax As Long
varData = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
lngRijen = UBound(varData, 1)
For lngRij = 1 To lngRijen
varData(lngRij, 6) = varData(lngRij, 5) - varData(lngRij, 4) + 1
lngRijMax = lngRijMax + varData(lngRij, 6)
Next lngRij
If lngRijMax < Rows.Count Then
ReDim varSplitData(1 To lngRijMax, 1 To 4)
lngRijTotaal = 1
For lngRij = 1 To lngRijen
For x = 0 To varData(lngRij, 6) - 1
For y = 1 To 3
varSplitData(lngRijTotaal + x, y) = varData(lngRij, y)
Next y
varSplitData(lngRijTotaal + x, 4) = varData(lngRij, 4) + x
Next x
lngRijTotaal = lngRijTotaal + varData(lngRij, 6)
Next lngRij
Range("G2").Resize(lngRijMax, 4).Value = varSplitData
Range("G1:J1").Value = Array("Id", "Naam", "Afwezigheidscode", "Datum")
Else
MsgBox "Te veel rijen"
End If
End Sub
Soms staan je gegevens op een ongelukkige manier gerangschikt in slechts één kolom. Dus vertikaal. Er zit wél regelmaat in. Bijvoorbeeld telkens 6 rijen gegevens die bij elkaar horen. Je kunt die gegevens eenvoudig verdelen zodat ze in rijen (horizontaal) komen te staan.
Zie afbeeldingen ter illustratie. VOOR:
NA:
1. Kopieer de onderstaande code 2. Open een nieuwe werkmap 3. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen 4. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen 5. Druk op M om een standaard module in te voegen 6. Daar waar de cursor knippert voeg je de code in middels Ctrl + V 7. Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel 8. Formule invoegen in bijvoorbeeld [C1] =SplitText($A1; COLUMN()-2) en naar rechts doorvoeren.
Function SplitText(ByVal Cell As Range, ByVal LineNumber As Integer) As String
Dim Lines As Variant
Lines = Split(Cell.Value, Chr(10))
If LineNumber - 1 <= UBound(Lines) Then
SplitText = Lines(LineNumber - 1)
Else
SplitText = ""
End If
End Function
Formule invoegen in bijvoorbeeld [C1] =SplitText($A1; COLUMN()-2)
en naar rechts doorvoeren
Hoe haal je het numerieke gedeelte op uit een alfanumerieke tekenreeks? Bijvoorbeeld: als cel A3 de tekenreeks esd K+ WS4600 bevat, moet de waarde 4600 worden geretourneerd in cel B3 of in cel C3. Hiervoor hebben we 2 functies: strCountNumbers (in B3) en GetNumbers (in C3)
1. Kopieer de onderstaande code 2. Open een nieuwe werkmap 3. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen 4. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen 5. Druk op M om een standaard module in te voegen 6. Daar waar de cursor knippert voeg je de code in middels Ctrl + V 7. Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel 8. Formule invoegen in juiste cel.
Bijvoorbeeld in B3: =strCountNumbers(A3) of =GetNumbers(A3)
Function strCountNumbers(strText As String) As String
Dim intLengte As Integer, strChar As String, X As Integer, strNumber As String
intLengte = Len(strText)
For X = 1 To intLengte
strChar = Mid(strText, X, 1)
If strChar Like "[0-9]" Then
strNumber = strNumber & strChar
End If
Next
strCountNumbers = strNumber
End Function
Function GetNumbers(ByVal strText As String) As String
Dim X As Long
For X = 1 To Len(strText)
If Mid(strText, X, 1) Like "[!0-9]" Then Mid(strText, X) = " "
Next
GetNumbers = Replace(strText, " ", "")
End Function
