Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1180to1184
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

Code ergänzen

Code ergänzen
Walterk
Hallo zusammen,
zur Formatierung meiner Tabelle habe ich mit Hilfe des Forums und mit dem Makrorekorder den untenstehenden etwas längeren Code "Tabelleeinrichten" erstellt und er funktioniert auch. Es handelt sich nur um einen Ausschnitt aus dem Code.
Jetzt sollten noch zusätzlich alle Hochkommas aus der Tabelle entfernt werden, in der Recherche habe ich dafür diese Codezeilen gefunden:
Sub hk_weg()
Dim zelle As Range
On Error Resume Next
For Each zelle In Selection
If zelle  "" Then zelle = zelle * 1
If Left(zelle, 1) = "'" Then
zelle = Right(zelle, Len(zelle) - 1)
End If
Next zelle
End Sub
Meine Bitte: Wer kann mir 1.) den oberen Code ändern, dass er das ganze Tabellenblatt betrifft und 2.) den oberen Code in den unteren Code einbauen, sodass die Hochkommas als erstes entfernt werden?
Option Explicit
Sub ACLTabelleeinrichten()
Dim lngA As Long
Dim I As Long
Dim LCol As Integer
LCol = Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
Range("A1:IV65536").Select
Selection.Replace what:=" ", Replacement:="", lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
With Selection.Font
.Name = "Tahoma"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
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
'   Beginn Texte ersetzen
usw.usw.


		

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Code ergänzen
25.10.2010 16:09:19
CitizenX
Hallo Walter,
[CODE]

Sub ACLTabelleeinrichten()
Dim lngA As Long _
span>
Dim I As Long _
span>
Dim LCol As  _
Integer
LCol = Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
 
With ActiveSheet
 
.Cells.Replace what:="'", Replacement:=""
.Cells.Replace what:=" ", Replacement:=""
 
With .Cells.Font
.Name = "Tahoma"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
 
ActiveWindow.Zoom = 85
.Cells.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.Rows("2:2").Select
ActiveWindow.FreezePanes = True
 
End With
'   Beginn Texte ersetzen
 

Grüße
Steffen
Anzeige
AW: Code ergänzen
25.10.2010 16:35:28
WalterK
Hallo Steffen,
so funktioniert es leider nicht. Es handelt sich um ein Hochkomma oder ein sonstiges Zeichen, das mit Suchen/Ersetzen nicht entfernt werden kann. Das Zeichen verhält sich genau so, wie es in diesem Dialog, den ich in der Recherche gefunden habe, besprochen wurde: www.herber.de/forum/archiv/460to464/t461454.htm
Den Lösungscode aus diesem Dialog, der für sich allein ja funktioniert, wollte ich in meinem Code auch verwenden. Ich bekomme es aber nicht hin, den Code richtig einzubauen und zwar so, dass er die ganze Tabelle berücksichtigt.
Besten Dank jedenfalls für Deine Mühe,
Servus, Walter
Anzeige
hast du..
25.10.2010 18:09:40
CitizenX
das getestet Walter?
Ich hab's mit deiner Original Datei( https://www.herber.de/bbs/user/8998.xls ) getestet und es ging..
Wenn Du wirklich ALLE Zellen einzeln abklappern willst dann kannst aber dauern bis das Makro abgearbeitet ist.
Grüße
Steffen
AW: hast du..
25.10.2010 18:42:53
WalterK
Hallo Steffen,
hier ein Beispiel aus meiner Datei:
https://www.herber.de/bbs/user/72042.xls
Der Codeteil muss nur für den Bereich funktionieren, soweit auch Daten eingetragen sind.
Danke und Servus, Walter
Anzeige
Probier mal das
25.10.2010 19:02:00
CitizenX
Walter , in deinem Bsp gehts:
[CODE]

Sub ACLTabelleeinrichten()
Dim lngA As Long, Zelle As Range
Dim I As Long _
span>
Dim LCol As  _
Integer
LCol = Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
 
With ActiveSheet
 
For Each Zelle In _
span> .UsedRange
Zelle = Replace(Zelle, "'", "")
Next
 
.Cells.Replace what:=" ", Replacement:=""
 
With .Cells.Font
.Name = "Tahoma"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
 
ActiveWindow.Zoom = 85
.Cells.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.Rows("2:2").Select
ActiveWindow.FreezePanes = True
 
End With
End Sub

Grüße
Steffen
Anzeige
TipTop Steffen, besten Dank! Walter
25.10.2010 19:50:26
WalterK
AW: Noch ein Spielzeug
25.10.2010 20:00:39
Gerd
Hallo Walter,
die Font-Eigenschaften, die du ggf. nicht neu festlegen musst, habe ich mit 'x gekennzeichnet.
Weshalb der Sort über alle Zellen der Tabelle gehen muss, verstehe ich nicht. Da ich hier verschiedene
Mustertabellen sah, habe ich aber da mal die Finger weggelassen.
Sub ACLTabelleeinrichten3()
Dim lngA As Long
Dim I As Long
Dim LCol As Long
LCol = Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
With ActiveSheet
.Cells.SpecialCells(xlCellTypeConstants).Value = .Cells.SpecialCells(xlCellTypeConstants). _
Value
.UsedRange.Cells.Replace what:=" ", Replacement:=""
With .Cells.Font
.Name = "Tahoma"
.Size = 10
.Strikethrough = False 'x
.Superscript = False 'x
.Subscript = False 'x
.OutlineFont = False 'x
.Shadow = False 'x
.Underline = xlUnderlineStyleNone 'x
.ColorIndex = xlAutomatic
End With
ActiveWindow.Zoom = 85
.Cells.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.Columns(1).NumberFormat = "0"
.UsedRange.Columns.AutoFit
.Rows("2:2").Select
ActiveWindow.FreezePanes = True
End With
End Sub
Gruß Gerd
Anzeige
Danke Gerd für Deine Hilfe. Servus, Walter
26.10.2010 10:27:02
WalterK

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige