Software für Sie.

Im Modul2 soll die Zeile Windows("Formulare").Activate ersetzt werden durch Windows("Formulare.xls").Activate.

Sub ZeileInCodeErsetzen() Dim strSuchtext As String, strNeuertext As String Dim intI As Integer strSuchtext = "Windows(" & """" & "Formulare" & """" & ").Activate" strNeuertext = "Windows(" & """" & "Formulare.xlsx" & """" & ").Activate" 'Jede Zeile in Modul2 wird durchsucht: With ActiveWorkbook.VBProject.VBComponents("Modul2").CodeModule For intI = 1 To .CountOfLines 'Wenn die Zeile gleich dem Suchtext ist, ... If .Lines(intI, 1) = strSuchtext Then '... Zeile löschen: .DeleteLines intI '... neue Zeile einfügen: .InsertLines intI, strNeuertext End If Next End With End Sub

Falls die Meldung Der programmatische Zugriff auf das Visual Basic-Projekt ist nicht sicher erscheint, müssen folgende Einstellungen vorgenommen werden:

Wenn vorher bekannt ist, wie viele Unterstriche enthalten sein können, kann das verwendet werden:

Sub Unterstriche() Dim intI As Integer Application.ScreenUpdating = False '10 = maximale Zahl der Unterstriche For intI = 1 To 10 Range("A1:A65536").Replace What:="__", Replacement:="_", LookAt:=xlPart, SearchOrder:=xlByRows Next Range("A1").Select Application.ScreenUpdating = True End Sub

Ansonsten kann auch eine While-Schleife so lange laufen, wie noch doppelte Unterstriche gefunden werden:

Dim objGef As Object Set objGef = Cells.Find("__") Do While Not objGef Is Nothing Cells.Replace "__", "_" Set objGef = Cells.Find("__") Loop

Variante mit regulären Ausdrücken:

Sub Doppelte_Unterstriche() Dim strRepl As String, rngZelle As Range Dim Regex As Object, regMatches, regMatch If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") strRepl = "_" Regex.Global = True Regex.Pattern = "(__+)" For Each rngZelle In ActiveSheet.UsedRange Set regMatches = Regex.Execute(rngZelle) rngZelle = Regex.Replace(rngZelle, strRepl) Next Set Regex = Nothing End Sub

Beispiel 1:

Manchmal ist bei Eingaben wichtig, dass es sich wirklich um eine Zahl handelt. Deshalb wird in diesem Beispiel mittels einer Schleife solange abgefragt, bis wirklich eine Zahl eingegeben wurde:

Sub Fehlermakro() Dim varI varI = "" Do While Not IsNumeric(varI) varI = InputBox("Bitte geben Sie eine Zahl ein:", "Zahl eingeben") Loop MsgBox varI End Sub

Beispiel 2:

Eingabeaufforderung: da intI als Zahl deklariert ist, dürfen auch nur Zahlen eingegeben werden. Gibt man einen Text ein, tritt der Fehler 13 auf und es wird zur Sprungmarke Fehler: gesprungen.

Wird korrekt eine Zahl eingegeben, erscheint die Zahl als Meldung und das Makro wird verlassen.

Sub Fehlermakro1() Dim intI As Integer On Error GoTo Fehler intI = InputBox("Bitte geben Sie eine Zahl ein:", "Zahl eingeben") MsgBox intI Exit Sub 'Fehlerbehandlung: Fehler: 'Wenn der Fehler 13 aufgetreten ist ... If Err.Number = 13 Then '... eine Meldung bringen ... MsgBox "Sie haben keine gültige Zahl eingegeben.", vbOKOnly + vbExclamation, "Fehler!" 'bei einem anderen Fehler eine Meldung bringen Else MsgBox "Ein unerwarteter Fehler ist aufgetreten. Das Makro wird beendet.", vbOKOnly + vbCritical, "Unerwarteter Fehler" End If Err.Clear End Sub

Download: fehlerbehandlung.xlsm

Die integrierten Dialogfelder von Excel können auch mit VBA aufgerufen werden. Dies geschieht einfach mit:

Application.Dialogs(Konstante).Show

Bei den Dialogfeldern können verschiedene Argumente mitgegeben werden, die natürlich bei jedem Element anders sind. Hierzu am besten einfach in die Hilfe sehen.

Manchmal muss man sich entscheiden, ob ein integriertes Dialogfeld oder ein herkömmliches Dialogfeld für die Aufgabe besser geeignet ist. Mit z. B. Application.GetOpenFilename kann schön der Pfad abgefragt werden, was mit xlDialogOpen schon nicht mehr so einfach ist.

Download: integrierte_dialogfelder.xlsm

Die folgende Funktion speichert mit Environ() den lokalen OneDrive-Ordner in eine Variable. Anschlie�end ersetzt sie im Pfad der Datei diverse mögliche Zeichenfolgen, die OneDrive selbst vergibt. Mit einem regulären Ausdruck wird dann der OneDrive-Teil im Pfad der Datei durch den lokalen Pfad ersetzt.

Ggf. können noch ein paar Fehlerbehandlungen eingebaut werden.

Function OneDrive2Lokal(ByVal strPfad As String) As String Dim strOnedrivePfad As String, RegEx As Object, regMatches OneDrive2Lokal = "" If RegEx Is Nothing Then Set RegEx = CreateObject("VBScript.RegExp") If Left(strPfad, 6) = "https:" Then strOnedrivePfad = Environ("OneDrive") & "\" ' oder "OneDriveConsumer" strPfad = Replace(strPfad, "^J", ",") strPfad = Replace(strPfad, "^N", "#") strPfad = Replace(strPfad, "^0", "&") RegEx.Pattern = "^(https:/{2}[A-Za-z0-9./]+/)" Set regMatches = RegEx.Execute(strPfad) strPfad = Replace(RegEx.Replace(strPfad, strOnedrivePfad), "/", "\") End If OneDrive2Lokal = strPfad Set RegEx = Nothing End Function

Die Funktion kann beliebig verwendet werden, zum Beispiel:

MsgBox OneDrive2Lokal(ThisWorkbook.FullName)

Sub Raus_damit() Dim strInhalt As String, lngZ1 As Long, lngZn As Long, lngZ As Long Dim intS As Integer, intI As Integer, intZ As Integer intS = 1 'Spalte A lngZ1 = 1 'Erste Zeile lngZn = 25 'Letzte Zeile For lngZ = lngZ1 To lngZn strInhalt = Cells(lngZ, intS) For intI = 1 To Len(strInhalt) intZ = Asc(Mid(strInhalt, intI, 1)) If intZ >= 123 And intZ <= 255 Then Mid(strInhalt, intI, 1) = "_" Next Cells(lngZ, intS) = strInhalt Next End Sub

Vor das Sternchen setzt man einfach eine Tilde ~.

Sub Stern_ersetzen() Cells.Replace "~*", "", xlWhole End Sub

In Inputboxen werden zu suchender Text und neuer Text eingegeben. Anschlie�end wird auf jedem Tabellenblatt der Mappe die Ersetzung durchgeführt.

Sub suchersetz() Dim strSuchBegriff As String, strErsetzBegriff As String Dim wks As Worksheet strSuchBegriff = Application.InputBox("Bitte den zu suchenden Begriff eingeben") strErsetzBegriff = Application.InputBox("Bitte den Ersatzbegriff eingeben") For Each wks In ActiveWorkbook.Worksheets wks.UsedRange.Replace what:=strSuchBegriff, replacement:=strErsetzBegriff, lookat:=xlPart, searchOrder:=xlByColumns, MatchCase:=False Next End Sub

Ggf. kann hier noch eine Fehlerbehandlung eingebaut werden, wenn zum Beispiel eine InputBox abgebrochen wurde.

Es gibt verschiedene Möglichkeiten. Ein zweidimensionaler Array würde nahe liegen, aber mit dieser Variante ist es etwas kürzer.

Wandelt Umlaute und das Ã? in Selbstlaute um:

Sub InSelbstlaute() Dim arrSuchen(), arrErsetzen(), intI As Integer arrSuchen = Array("�", "�", "�", "ö", "ä", "ü", "�") arrErsetzen = Array("Oe", "Ae", "Ue", "oe", "ae", "ue", "ss") For intI = 0 To UBound(arrSuchen) Range("A5:C10").Replace What:=arrSuchen(intI), Replacement:=arrErsetzen(intI), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True Next End Sub

Die Schleife läuft über den ersten Array und ersetzt im Range das gerade durchlaufene Zeichen durch den String, der im zweiten Array an der gleichen Stelle ist.

Wandelt Selbstlaute und ss in Umlaute um:

Sub InUmlaute() Dim arrSuchen(), arrErsetzen(), intI As Integer arrSuchen = Array("Oe", "Ae", "Ue", "oe", "ae", "ue", "ss") arrErsetzen = Array("�", "�", "�", "ö", "ä", "ü", "�") For intI = 0 To UBound(arrSuchen) Range("A5:C10").Replace What:=arrSuchen(intI), Replacement:=arrErsetzen(intI), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True Next End Sub

Mit dem â??ssâ?? muss man natürlich aufpassen, das darf nicht mehr generell ersetzt werden. Hier muss also je nach Situation bzw. Anforderungen verfahren werden.

Hier ist eine benutzerdefinierte Funktion:

Function zahl_aufteilen(Zahl, Ziffer, Trenner) Application.Volatile Dim intI As Integer Dim strTemp As String, strTrenner As String strTrenner = Ziffer & Trenner strTemp = Replace(Zahl, Ziffer, strTrenner) If Right(strTemp, 1) = Trenner Then strTemp = Left(strTemp, Len(strTemp) - 1) zahl_aufteilen = strTemp End Function

Dazu mit Alt und F11 den Editor aufrufen, ein Modul einfügen und die Function eingeben. In die Zelle kommt dann z. B. die folgende Formel:

=zahl_aufteilen(B6;0;"-")

Regulärer Ausdruck

Eine weitere Variante ist diese Funktion:

Function Zahl_Aufteilen_Regex(ByVal varZahl, ByVal strTrenner As String, intZiffer As Integer) Dim Regex As Object, regMatches Set Regex = CreateObject("VBScript.RegExp") Regex.Global = True Regex.Pattern = intZiffer & "\B" Set regMatches = Regex.Execute(varZahl) Zahl_Aufteilen_Regex = Regex.Replace(varZahl, intZiffer & strTrenner) Set Regex = Nothing End Function

In die Zelle käme diese Formel:

=Zahl_Aufteilen_Regex(B6;"-"; 0)

Dieser Code ersetzt das unsichtbare Zeichen mit einem Mal in allen Zellen der aktiven Tabelle:

Sub ZeilenumbruecheErsetzen() ActiveSheet.Cells.Replace Chr(10), " " End Sub

Auch das Kontextmenü in Excel wird nun per RibbonX angesprochen. Hier ist eine sehr gute Anleitung: RibbonX-Workshop - Das Kontextmenü.

Der alte Code:

Sub Kontext() Dim cbnNeuesMenue As CommandBarButton With CommandBars("Cell") Do While .Controls.Count > 0 On Error Resume Next .Controls(1).Delete Loop Set cbnNeuesMenue = .Controls.Add(msoControlButton) With cbnNeuesMenue .Caption = "&Signalton" .OnAction = "Ton" End With End With End Sub