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