Excel Macro's en Functies voor blokken met tekst

Ik werk vaak met diverse text of database bestanden waarbij de gegevens niet eenvoudig te splitsen zijn omdat er b.v. spaties voor en achter de gegevens staan of omdat de gebruikersnamen aan elkaar geplakt zijn waarbij ik alleen de hoofdletter van de voor en achternaam kan gebruiken om de namen weer uit elkaar te halen b.v. JanPeterBalkenende moet zijn Jan Peter Balkenende. Ook heb ik soms bestanden waar lege regels in zitten. Natuurlijk kan je, nadat je een extra kolom met oplopende nummers hebt toegevoegd om de oorspronkelijke volgorde terug te krijgen, het geheel sorteren en dan de lege rijen eruit halen, maar een macrotje doet dat wel zo snel. De meeste varianten pas ik regelmatig even aan aan de wens van dat moment, dus zijn deze maco's niet lang het zelfde bij mij. Om ze aan je eigen bibliotheek toe te voegen kun je op [Alt]+[F11] drukken om de VBA editor te openen.

Hier is een overzicht van de verschillende functies:














Sorry for the image of the table, adding a table in html caused some funny behaviour by blogger.


Here are some Macro's and functions which over time I found, modified or wrote my self to manipulate text blocks. Most of them are to split text strings e.g. to split a string on Caps turns JanPeterBalkenende in Jan Peter Balkenende. I often modify these functions as needed.

Again to add these, open your VBA editor by pressing [Alt]+[F11] and select [Alt]+[F8] to select the Macro's or use the "Function" button before the edit line and select "User Created" functions.

====Start of Macro Section======
Sub RemoveSpaces()
' Keyboard Shortcut: Ctrl+Shift+T
' Use Ctrl+Shift+T to Trim all SPACES in a selection, You must assign the Ctrl+Shit+WhateverLetter your self
' by using [Alt] + [F8] in Excel, select the macro and then press Options
For Each r In Selection
a = r.Address
r.Value = Evaluate("Trim(" & a & ")")
Next
End Sub
'=====
Sub DeleteBlankRows()
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim i As Long
'We turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'We work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
'=====
Function CommaBeforeEveryCap(S As String) As String
'RobertVanDeMaan > Robert,Van,De,Maan
Dim X As Long
CommaBeforeEveryCap = S
For X = Len(CommaBeforeEveryCap) To 2 Step -1
If Mid(CommaBeforeEveryCap, X, 1) Like "[A-Z]" Then
CommaBeforeEveryCap = Left(CommaBeforeEveryCap, X - 1) & "," & Mid(CommaBeforeEveryCap, X)
End If
Next
End Function
'=====
Function SwapOnFirstCap(S As String) As String
'RobertVanDeMaan > VanDeMaan,Robert
Dim X As Long
SwapOnFirstCap = S
For X = 2 To Len(SwapOnFirstCap) Step 1
If Mid(SwapOnFirstCap, X, 1) Like "[A-Z]" Then
SwapOnFirstCap = Mid(SwapOnFirstCap, X) & "," & Left(SwapOnFirstCap, X - 1)
X = Len(SwapOnFirstCap)
End If
Next
End Function
'=====
Function CommaBeforeFirstNum(S As String) As String
'RobertVanDeMaan123 > RobertVanDeMaan,123
Dim X As Long
CommaBeforeFirstNum = S
For X = 2 To Len(CommaBeforeFirstNum) Step 1
If Mid(CommaBeforeFirstNum, X, 1) Like "[0-9]" Then
CommaBeforeFirstNum = Left(CommaBeforeFirstNum, X - 1) & "," & Mid(CommaBeforeFirstNum, X)
X = Len(CommaBeforeFirstNum)
End If
Next
End Function
'=====
Function CommaBeforeFirstCap(S As String) As String
'RobertVanDeMaan > Robert,VanDeMaan
Dim X As Long
CommaBeforeFirstCap = S
For X = 2 To Len(CommaBeforeFirstCap) Step 1
If Mid(CommaBeforeFirstCap, X, 1) Like "[A-Z]" Then
CommaBeforeFirstCap = Left(CommaBeforeFirstCap, X - 1) & "," & Mid(CommaBeforeFirstCap, X)
X = Len(CommaBeforeFirstCap)
End If
Next
End Function
'=====
Function RemoveBeforeLastDot(S As String) As String
'RobertVanDeMaan.com > com
Dim Y As Long
RemoveBeforeLastDot = S
For Y = Len(RemoveBeforeLastDot) To 1 Step -1
If Mid(RemoveBeforeLastDot, Y, 1) Like "." Then
RemoveBeforeLastDot = Mid(RemoveBeforeLastDot, Y + 1)
Y = 1
End If
Next
End Function
'=====
Function RemoveAfterLastDot(S As String) As String
'RobertVanDeMaan.com > RobertVanDeMaan
Dim Y As Long
RemoveAfterLastDot = S
For Y = Len(RemoveAfterLastDot) To 2 Step -1
If Mid(RemoveAfterLastDot, Y, 1) Like "." Then
RemoveAfterLastDot = Left(RemoveAfterLastDot, Y - 1)
Y = 1
End If
Next
End Function
'=====
Function CommaForLastSpace(S As String) As String
'Robert Van De Maan > Robert Van De, Maan
Dim Y As Long
CommaForLastSpace = S
For Y = Len(CommaForLastSpace) To 2 Step -1
If Mid(CommaForLastSpace, Y, 1) Like " " Then
CommaForLastSpace = Left(CommaForLastSpace, Y - 1) & "," & Mid(CommaForLastSpace, Y)
Y = 1
End If
Next
End Function
'=====
Function CommaForFirstSpace(S As String) As String
'Robert Van De Maan > Robert, Van De Maan
Dim X As Long
CommaForFirstSpace = S
For X = 2 To Len(CommaForFirstSpace) Step 1
If Mid(CommaForFirstSpace, X, 1) = " " Then
CommaForFirstSpace = Left(CommaForFirstSpace, X - 1) & "," & Mid(CommaForFirstSpace, X)
X = Len(CommaForFirstSpace)
End If
Next
End Function
'=====
Function CommaForSecondSpace(S As String) As String
'Robert Van De Maan > Robert Van, De Maan
Dim X As Long, MyCount As Long, Occurence As Long
CommaForSecondSpace = S
Occurence = 2
MyCount = 0
For X = 2 To Len(CommaForSecondSpace) Step 1
If Mid(CommaForSecondSpace, X, 1) = " " Then
MyCount = MyCount + 1
If MyCount = Occurence Then
CommaForSecondSpace = Left(CommaForSecondSpace, X - 1) & "," & Mid(CommaForSecondSpace, X)
X = Len(CommaForSecondSpace)
End If
End If
Next
End Function
'=====
Sub ClearTextToColumns()
'Once you used text to columns, Excel remembers this and performs this action on ANY text data that you paste into the spreadsheet.
'To stop this behaviour, you need to reset the text to columns settings.
On Error Resume Next
If IsEmpty(Range("A1")) Then Range("A1") = "XYZZY"
Range("A1").TextToColumns Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=False, _
OtherChar:=""
If Range("A1") = "XYZZY" Then Range("A1") = ""
If Err.Number <> 0 Then MsgBox Err.Description
End Sub

======End of Macro Section=====