Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1184to1188
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: nochmals Hochkomma entfernen

VBA: nochmals Hochkomma entfernen
WalterK
Hallo,
Ich bringe bei meinen importierten Texten die Hochkommas nicht weg. Habe die Frage vorgestern schon gestellt und von ransi auch eine Antwort erhalten und glaubte auch, dass es funktionierte. Dem ist aber nicht so.
Das Problem ist bei meinem Codebeispiel in den Bereichen 3 und 4: Es sollen bis zur letzten befüllten Zeile und bis zur letzten befüllten Spalte alle Hochkommas, Leerzeichen und "FALSCH"-Texte entfernt werden.
Hier mein Code und eine Beispieltabelle:
https://www.herber.de/bbs/user/72099.xls
Option Explicit
Sub Tabelleeinrichten()
Dim lngA As Long, Zelle As Range
Dim I As Long
Dim LCol As Integer
Dim LZ As Long
Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
'***Bereich 1 - letzte Zeile und letzte Spalte ermitteln***
lngA = Cells(Rows.Count, 1).End(xlUp).Row 'Letzte gefüllte Zelle in Spalte "A" ermitteln [,  _
1) = A; , 2) = B; ...]
LCol = Cells(1, Columns.Count).End(xlToLeft).Column 'Letzte Spalte ermitteln, in der in  _
Zeile 1 eine Überschrift steht
'***Bereich 2 - Leer***
'***Bereich 3 - Hochkomma, Leerzeichen und FALSCH entfernen***
With ActiveSheet
For Each Zelle In .UsedRange
If InStr(1, Zelle.Text, "'") Then
Zelle = Replace(Zelle, "'", "")
End If
Next
.Cells.Replace what:=" ", Replacement:=""
.Cells.Replace what:="FALSCH", Replacement:=""
End With
'***Bereich 4 - numerische Zellen in Werte umwandeln***
For Each Zelle In ActiveSheet.UsedRange
If Zelle  "" And IsNumeric(Zelle) Then Zelle = Zelle * 1
Next Zelle
'***Bereich 5 - den befüllten Bereich der Tabelle formatieren***
Range(Cells(1, 1), Cells(lngA, LCol)).Select
With Selection.Font
.Name = "Tahoma"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
Selection.NumberFormat = "#,##0.00;[Red]-#,##0.00;"
End With
'***Bereich 6 - den befüllten Bereich der Tabelle ab Zeile 3 nach Spalte A sortieren***
Range(Cells(3, 1), Cells(lngA, LCol)).Select
ActiveWindow.Zoom = 85
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("2:2").Select
ActiveWindow.FreezePanes = True
'***Bereich 7 - Überschrift-Texte ändern --- hier sind 2 von den insgesamt 40 angeführt***
Rows("1:1").Replace what:="NAME", Replacement:= _
"FAMILIENNAME", lookat:=xlPart, SearchOrder:=xlByRows, MatchCase _
:=False, SearchFormat:=False, ReplaceFormat:=False
Rows("1:1").Replace what:="F-NUMMER", Replacement:= _
"NUMMER", lookat:=xlPart, SearchOrder:=xlByRows, MatchCase _
:=False, SearchFormat:=False, ReplaceFormat:=False
'***Bereich 8 - eine Zeile vor Zeile 1 einfügen***
Rows(1).Insert
'***Bereich 9 - Teilergebnisformel in B2 eintragen und nach rechts bis zum Tabellenende  _
kopieren***
LZ = Cells(Rows.Count, 1).End(xlUp).Row 'Letzte gefüllte Zelle in Spalte "A" ermitteln ( _
nach dem Einfügen von Zeile 1)
With Range("B1")
.FormulaLocal = _
"=WENN(oder(ODER(B2="""";B2=""FAMILIENNAME"";B2=""NUMMER"";B2=""BEZEICHNUNG""; _
B2=""ANMERKUNG""));"""";" & _
"WENN(ISTZAHL(B3);TEILERGEBNIS(9;B3:B" & LZ & ");""""))"
.NumberFormat = "#,##0.00;[Red]-#,##0.00;"
.AutoFill Destination:=Range(Cells(1, 2), Cells(1, LCol)), Type:=xlFillDefault
End With
'***Bereich 10 - beim gesamten befüllten Bereich der Tabelle die optimale Spaltenbreite  _
einrichten***
LZ = Cells(Rows.Count, 1).End(xlUp).Row 'Letzte gefüllte Zelle in Spalte "A" ermitteln ( _
nach dem Einfügen von Zeile 1)
Range(Cells(1, 1), Cells(LZ, LCol)).Select
Selection.Columns.AutoFit
Range("A1").Select
End Sub
Den Code habe ich mit Hilfe vom Forum, dem Makrorekorder und der Recherche zusammengeschustert. Ich bewege mich in VBA wie "ein Blinder im Minenfeld" und habe daher auch nichts dagegen, wenn Verbesserungen (z.B. Select's entfernen) vorgenommen werden.
Besten Dank für die Hilfe und Servus, Walter

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA: nochmals Hochkomma entfernen
30.10.2010 19:04:24
Oberschlumpf
Hi Walter
Für Bereich 3 hab ich es in deiner Datei so gelöst:

'***Bereich 3 - Hochkomma, Leerzeichen und FALSCH entfernen***
With ActiveSheet
For Each Zelle In .UsedRange
If Not IsNumeric(Zelle) Then
Zelle = Zelle
End If
Next

Bereich 4 musste ich an meinem PC nicht korrigieren, da nach Ausführen des gesamten Codes die Zahlen mit Hochkomma in echte Zahlenwerte umgewandelt waren.
Hilfts denn?
Ciao
Thorsten
AW: VBA: nochmals Hochkomma entfernen
30.10.2010 19:45:57
WalterK
Hallo Thorsten,
ja, das hilft, jetzt funktionierts bestens.
Eine Bitte hätte ich noch. Mein Code bis einschließlich Bereich 4 sieht jetzt so aus:
Option Explicit
Sub Tabelleeinrichten()
Dim lngA As Long, Zelle As Range
Dim I As Long
Dim LCol As Integer
Dim LZ As Long
Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
'***Bereich 1 - letzte Zeile und letzte Spalte ermitteln***
lngA = Cells(Rows.Count, 1).End(xlUp).Row 'Letzte gefüllte Zelle in Spalte "A" ermitteln [, 1) = A; , 2) = B; ...]
LCol = Cells(1, Columns.Count).End(xlToLeft).Column 'Letzte Spalte ermitteln, in der in Zeile 1 eine Überschrift steht
'***Bereich 2 - Leer***
'***Bereich 3 - Hochkomma, Leerzeichen und FALSCH entfernen***
With ActiveSheet
For Each Zelle In .UsedRange
If Not IsNumeric(Zelle) Then
Zelle = Zelle
End If
Next
.Cells.Replace what:=" ", Replacement:=""
.Cells.Replace what:="FALSCH", Replacement:=""
End With
'***Bereich 4 - numerische Zellen in Werte umwandeln***
For Each Zelle In ActiveSheet.UsedRange
If Zelle "" And IsNumeric(Zelle) Then Zelle = Zelle * 1
Next Zelle
'***Bereich 5 - den befüllten Bereich der Tabelle formatieren***
Kannst Du mir Bereich 3 und 4 noch so abändern, dass nur der Bereich bis zur letzten befüllten Zeile und bis zur letzten befüllten Spalte bearbeitet wird?
Besten Dank jedenfalls für Deine Hilfe und Servus Walter
Anzeige
AW: VBA: nochmals Hochkomma entfernen
30.10.2010 20:14:56
fcs
Hallo Walter,
mit
For Each Zelle in ActiveSheet.UsedRange
werden alle Zellen des benutzten Bereichs abgearbeitet, also eigentlich alle Zeilen und alle Spalten, die in Benutzung sind.
Dies kann abweichen von Zellen mit Inhalten, wenn Zellen außerhalb des eigentlichen Wertebereichs Formatierungen oder Leerstrings enthalten.
Ansonsten kannst du so wie im Bereich 5 den Zellebereich festlegen, der barbeitte werden soll und statt UsedRange verwenden.
Nachfolgend mein Vorschlag für dein Makro mit ein paar Anpassungen.
Beim Ersetzen der Überschriften-Texte solltest du ggf. mit xlWhole statt xlPart arbeiten, damit es nicht zu unerwünschten Teiersetzungen kommt.
Gruß
Franz
Sub Tabelleeinrichten()
Dim lngA As Long, Zelle As Range
Dim I As Long
Dim LCol As Integer
Dim LZ As Long
Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
'***Bereich 1 - letzte Zeile und letzte Spalte ermitteln***
lngA = Cells(Rows.Count, 1).End(xlUp).Row 'Letzte gefüllte Zelle in Spalte "A" ermitteln [,  _
_
1) = A; , 2) = B; ...]
LCol = Cells(1, Columns.Count).End(xlToLeft).Column 'Letzte Spalte ermitteln, in der in _
Zeile 1 eine Überschrift steht
'***Bereich 2 - Leer***
'***Bereich 3 - Leerzeichen und FALSCH entfernen***
With ActiveSheet
With .UsedRange
.EntireColumn.NumberFormat = "General"
.Replace what:=" ", Replacement:=""
.Replace what:="FALSCH", Replacement:=""
End With
End With
'***Bereich 4 - numerische Zellen in Werte umwandeln und Hochlomma entfernen***
For Each Zelle In ActiveSheet.UsedRange
If Zelle = "" Then
Zelle.ClearContents
Else
If (InStr(2, Zelle.Text, ".") Or InStr(2, Zelle.Text, ":")) _
And IsDate(Zelle.Text) Then 'Text=Datum/Uhrzeit ?
Zelle.Value = CDate(Zelle.Text)
ElseIf IsNumeric(Zelle.Text) Then 'Text = Zahl ?
Zelle.Value = CDbl(Zelle.Text)
Else
Zelle.Value = Zelle.Text
End If
End If
Next Zelle
'***Bereich 5 - den befüllten Bereich der Tabelle formatieren***
With Range(Cells(1, 1), Cells(lngA, LCol))
With .Font
.Name = "Tahoma"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.NumberFormat = "#,##0.00;[Red]-#,##0.00;"
End With
'***Bereich 6 - den befüllten Bereich der Tabelle ab Zeile 3 nach Spalte A sortieren***
ActiveWindow.Zoom = 85
With Range(Cells(3, 1), Cells(lngA, LCol))
.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Rows("2:2").Select
ActiveWindow.FreezePanes = True
'***Bereich 7 - Überschrift-Texte ändern --- hier sind 2 von den insgesamt 40 angeführt***
Rows("1:1").Replace what:="NAME", Replacement:= _
"FAMILIENNAME", lookat:=xlWhole, SearchOrder:=xlByRows, MatchCase _
:=False, SearchFormat:=False, ReplaceFormat:=False
Rows("1:1").Replace what:="F-NUMMER", Replacement:= _
"NUMMER", lookat:=xlWhole, SearchOrder:=xlByRows, MatchCase _
:=False, SearchFormat:=False, ReplaceFormat:=False
'***Bereich 8 - eine Zeile vor Zeile 1 einfügen***
Rows(1).Insert
'***Bereich 9 - Teilergebnisformel in B2 eintragen und nach rechts bis zum Tabellenende _
kopieren***
LZ = Cells(Rows.Count, 1).End(xlUp).Row 'Letzte gefüllte Zelle in Spalte "A" ermitteln ( _
_
nach dem Einfügen von Zeile 1)
With Range("B1")
.FormulaLocal = _
"=WENN(oder(ODER(B2="""";B2=""FAMILIENNAME"";B2=""NUMMER"";" _
& "B2=""BEZEICHNUNG"";B2=""ANMERKUNG""));"""";" & _
"WENN(ISTZAHL(B3);TEILERGEBNIS(9;B3:B" & LZ & ");""""))"
.NumberFormat = "#,##0.00;[Red]-#,##0.00;"
.AutoFill Destination:=Range(Cells(1, 2), Cells(1, LCol)), Type:=xlFillDefault
End With
'***Bereich 10 - beim gesamten befüllten Bereich der Tabelle die optimale Spaltenbreite _
einrichten*** nach dem Einfügen von Zeile 1)
ActiveSheet.UsedRange.EntireColumn.AutoFit
Range("A1").Select
End Sub

Anzeige
AW: VBA: nochmals Hochkomma entfernen
30.10.2010 20:51:57
WalterK
Hallo Franz,
ich habe jetzt alles -- hoffentlich richtig - umgesetzt und auch in den Bereichen 3 und 4 das .UsedRange ersetzt. Bis auf eine Sache funktioniert es: aber "FALSCH" wird nicht eliminiert.
Ich habe jetzt den Code bis einschl. Bereich 4 nochmals kopiert, vielleicht kannst Du mir noch einmals behilflich sein.
Option Explicit
Sub Tabelleeinrichten()
Dim lngA As Long, Zelle As Range
Dim I As Long
Dim LCol As Integer
Dim LZ As Long
Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
'***Bereich 1 - letzte Zeile und letzte Spalte ermitteln***
lngA = Cells(Rows.Count, 1).End(xlUp).Row 'Letzte gefüllte Zelle in Spalte "A" ermitteln [, 1) = A; , 2) = B; ...]
LCol = Cells(1, Columns.Count).End(xlToLeft).Column 'Letzte Spalte ermitteln, in der in Zeile 1 eine Überschrift steht
'***Bereich 2 - Leer***
'***Bereich 3 - Leerzeichen und FALSCH entfernen***
With ActiveSheet
' With .UsedRange
With Range(Cells(1, 1), Cells(lngA, LCol))
.EntireColumn.NumberFormat = "General"
.Replace what:=" ", Replacement:=""
.Replace what:="FALSCH", Replacement:=""
End With
End With
'***Bereich 4 - numerische Zellen in Werte umwandeln und Hochkomma entfernen***
' For Each Zelle In ActiveSheet.UsedRange
For Each Zelle In ActiveSheet.Range(Cells(1, 1), Cells(lngA, LCol))
If Zelle = "" Then
Zelle.ClearContents
Else
If (InStr(2, Zelle.Text, ".") Or InStr(2, Zelle.Text, ":")) _
And IsDate(Zelle.Text) Then 'Text=Datum/Uhrzeit ?
Zelle.Value = CDate(Zelle.Text)
ElseIf IsNumeric(Zelle.Text) Then 'Text = Zahl ?
Zelle.Value = CDbl(Zelle.Text)
Else
Zelle.Value = Zelle.Text
End If
End If
Next Zelle
'***Bereich 5 - den befüllten Bereich der Tabelle formatieren***
Danke und Servus, Walter
Anzeige
AW: VBA: nochmals Hochkomma entfernen
30.10.2010 21:11:26
fcs
Hallo Walter,
probiere mal folgende Anpassung der If-Anweisung.
'***Bereich 4 - numerische Zellen in Werte umwandeln***
For Each Zelle In ActiveSheet.UsedRange
If Zelle = "" Or Zelle.Text = "FALSCH" Or Zelle.Value = False Then
Zelle.ClearContents
Else

Ansonsten müsstest du mal eine Beispieltabelle (wie vor Makroausführung) mit ein paar Testdaten hochladen.
Gruß
Franz
Jetzt funktionierts, danke Franz! Servus Walter
30.10.2010 21:27:14
WalterK

18 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige