Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1576to1580
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 nur auf Grenzen anpassen

Code nur auf Grenzen anpassen
04.09.2017 07:38:47
Jens
Hallo
nachfolgender Code.

Sub Trennzeichen_AT_weg()
Dim i As Variant
' Zu ersetzende Zeichen
Dim arrRepl1 As Variant
arrRepl1 = Array("-", "_", "/", " ", ";", ",")
Dim arrRepl2 As Variant
arrRepl2 = Array(Worksheets("Daten").Range("AE2") & "at", Worksheets("Daten").Range("AE2") & _
"aT", Worksheets("Daten").Range("AE2") & "At", Worksheets("Daten").Range("AE2") & "AT", "at", "aT", "At", "AT", Worksheets("Daten").Range("AE2") & "(at)", Worksheets("Daten").Range("AE2") & "(aT)", Worksheets("Daten").Range("AE2") & "(At)", Worksheets("Daten").Range("AE2") & "(AT)", "(at)", "(aT)", "(At)", "(AT)")
With ThisWorkbook.Worksheets("Aufstellung")
Dim myRange As Range
Set myRange = .Range(.Cells(13, 2), .Cells(.Rows.Count, 2).End(xlUp))
' Zelle mit Austauschwert
Dim strNeuesZeichen
strNeuesZeichen = CStr(Worksheets("Daten").Range("AE2").Value)
Dim e As Variant
' Alle Zellen in der Suchspalte duchrgehen
For Each e In myRange
' Replacefunction mit allen zu ersetzenden Werten ausführen
For i = LBound(arrRepl1) To UBound(arrRepl1)
e.Value = Replace(e.Value, arrRepl1(i), strNeuesZeichen)
Next i
Next e
For Each e In myRange
' Replacefunction mit allen zu ersetzenden Werten ausführen (arrRepl2)
For i = LBound(arrRepl2) To UBound(arrRepl2)
If Right(e.Value, 2) = arrRepl2(i) Then
e.Value = Left(e.Value, Len(e.Value) - 2)
ElseIf Right(e.Value, 3) = arrRepl2(i) Then
e.Value = Left(e.Value, Len(e.Value) - 3)
ElseIf Right(e.Value, 4) = arrRepl2(i) Then
e.Value = Left(e.Value, Len(e.Value) - 4)
ElseIf Right(e.Value, 5) = arrRepl2(i) Then
e.Value = Left(e.Value, Len(e.Value) - 5)
End If
Next i
Next e
End With
End Sub

Der Code funktioniert sehr gut. Leider dauert er sehr lange bei großen Dateien.
Es würde reichen, wenn der Code zwischen i = bZ + 1 To bZ_nach ausgeführt werden würde.
Kann mir hier jemand weiterhelfen?

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code nur auf Grenzen anpassen
04.09.2017 09:00:55
ChrisL
hi Jens
was soll denn "bZ" sein?
Die Schleife mit Variable "e" läuft zweimal. Ich denke das kannst du in eine Schleife rein packen.
ScreenUpdating und Calculation ausgeschaltet? Gibt es noch Ereignisse/Events (z.B. Worksheet_Change)?
cu
Chris
AW: Code nur auf Grenzen anpassen
04.09.2017 09:04:46
Jens
Bz udn BZnach sind einfach meine Zeilen.
Hast du mir helfen? Ich weis nicht wie ich das anpassen soll.
Ereignisse gibt es nicht. Nur das was der obenaufgeführte Code eben hergibt.
AW: Code nur auf Grenzen anpassen
04.09.2017 09:37:40
ChrisL
vielleicht...
Set myRange = .Range(.Cells(13, 2), .Cells(Bz, 2))
AW: Code nur auf Grenzen anpassen
04.09.2017 09:20:01
Daniel
HI
speichere den Inhalt der Range myRange in einem Array,
laufe dann mit einer Schleife über die Werte dieses Arrays, bearbeite die Array-Werte und schreibe dann das Array zurück.
Dh. statt:
For each e in myRange
e = what ever you want
Next

dann
arrE = myRange.Value
for z = 1 to Ubound(arrE, 1)
For s = 1 to Ubound(arrE, 2)
arrE(z, s) = what ever you want
next s
next z
myRange.Value = arrE

Das ist schneller, weil jeder Zugriff auf Excelzellen mehr Zeit erfordert als der Zugriff auf ein Array (insbesondere beim Schreiben von Werten)
dann fällt es dir auch leichter, den Code nicht über den ganzen Bereich, sondern nur über einen Teilbereich laufen zu lassen.
(Wenn den Zellbereich nur eine Spalte hat, kannst du die innere Schleife weglassen)
Das Ersetzen von Texten kannst du auch mit der Excelmenüfunktion ERSETZEN ausführen lassen.
dann brauchst du keine Schleife über die Einzelzellen, sondern kannst das für den Zellbereich in einem Schritt ausführen.
dh ersetze:
        For Each e In myRange
' Replacefunction mit allen zu ersetzenden Werten ausführen
For i = LBound(arrRepl1) To UBound(arrRepl1)
e.Value = Replace(e.Value, arrRepl1(i), strNeuesZeichen)
Next i
Next e

durch
            For i = LBound(arrRepl1) To UBound(arrRepl1)
myRange.Replace arrRepl1(i), strNeuesZeichen, lookat:=xlpart
Next i
Gruß Daniel
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige