Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1908to1912
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1908to1912
1908to1912
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code Anpassung

Code Anpassung
03.12.2022 16:34:43
Thomas
Hallo zusammen,
ich brauch auch mal wieder Hilfe. Den Code habe ich aus dem Netz und versuchte ihn anzupassen was mir teils gelungen ist aber ich brauch das nun als Schleife und da komme ich nicht mehr weiter.

Sub Ersetzen()
Dim rngZelle As Range
Dim x As Integer
Dim D As Integer
Dim E As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Im Aktivem Tabellenblatt markiere ich den Bereich in Spalte B
'For x = 2 To 100
'For Each rngZelle In Selection
'   rngZelle.Value = Replace(rngZelle.Value, Sheets("Reperatur").Cells(x, D), Sheets("Reperatur").Cells(x, E))
'Next rngZelle
For Each rngZelle In Selection
rngZelle.Value = Replace(rngZelle.Value, Sheets("Reperatur").Range("D2"), Sheets("Reperatur").Range("E2"))
Next rngZelle
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call Calculate
'Next x
End Sub
Wie muss die Schleife im Tabellenblatt ("Reperatur") richtig lauten?
Mit freundlichen Grüßen
Thomas T.

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code Anpassung
03.12.2022 17:08:52
Herbert_Grom
Hallo Thomas,
evtl. so:

Option Explicit
Sub Ersetzen()
Dim rngZelle As Range, x As Integer
x = 1
With ActiveSheet
For Each rngZelle In Range("D2:D" & Range("D2").End(xlDown).Row)
x = x + 1
rngZelle.Value = Replace(rngZelle.Value, .Cells(x, "D"), .Cells(x, "E"))
Next rngZelle
End With
End Sub
Servus
AW: Code Anpassung
03.12.2022 17:39:53
Thomas
Hallo Herbert,
Danke für deine schnelle Antwort, doch das funktioniert nur wenn beides auf einem Tabellenblatt ist. Mein Bereich wo ersetzt werden soll markiere ich von Hand wie in meinem Code beschrieben. Aus dem Tabellenblatt "Reperatur" D2 soll dann gesucht werden und aus E2 steht das wie es ersetzt werden soll bzw durch was. D2:ist variabel, E2: ist gleich wie der aus Spalte D.
Reperatur ist nicht mein Aktive Tabelle in der ich den Bereich markiere wo ersetzt werden soll.
Gruß Thomas T.
Anzeige
AW: Code Anpassung
03.12.2022 18:01:57
Herbert_Grom
Hallo Thomas,
"Reparatur" heißt das Wort!
Dann ersetze halt "Activesheet" durch "Sheets("Reparatur"). Dann sollte es klappen.
Servus
AW: Code Anpassung
03.12.2022 18:05:54
Herbert_Grom
Wenn es wieder nicht funzt, dann lade mal eine Beispiel-AM hoch!
AW: Code Anpassung
03.12.2022 18:16:14
Thomas
Hallo Herbert,
mit Hilfe deines Codes habe ich es voll geschafft. Was ""alles ausmachen können, auch lag es nicht am Blattnamen der war überall gleich und das Zählt.
Hier der Code wie es funktioniert. Vielen Dank nochmal.

Sub Ersetzen()
Dim rngZelle As Range
Dim x As Integer
Dim D As Integer
Dim E As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.Name = "Basis"
'Im Aktivem Tabellenblatt markiere ich den Bereich in Spalte B
For x = 2 To 10
For Each rngZelle In Selection
rngZelle.Value = Replace(rngZelle.Value, Sheets("Reparatur").Cells(x, "D"), Sheets("Raperatur").Cells(x, "E"))
Next rngZelle
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call Calculate
Next x
End Sub
Gruß Thomas T.
Anzeige
AW: Bitte sehr & danke für die Rückmeldung! owt
03.12.2022 18:27:04
Herbert_Grom
,,,
AW: Code Anpassung
03.12.2022 18:13:50
Yal
Hallo Thomas,
eine der grössten Schwierigkeiten ist, sein Problem präzis genug zu beschreiben ;-)

Sub Ersetzen()
Dim Z As Range 'Z wie Zelle. Gross, weil Object. Lange Variablenamen nur notwendig, wenn viele Variablen oder Sub/Function sehr lang
Dim r As Integer 'r wie Row (Zeile). Klein, weil nicht Object.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Z In Selection 'wird nur auf die aktuelle ausgewählte Zellen angewendet. Selection ist nie leer.
For r = 2 To 100
With Sheets("Reperatur")
If .Cells(r, "D")  "" Then Z.Value = Replace(Z.Value, .Cells(r, "D"), .Cells(r, "E")) 'Cells erwartet ZeileNr und SpalteNr. SpalteNr kann auch als "A", "B", .. übergeben werden
End With
Next r
Next Z
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
'Call Calculate 'ist in einem Wechseln von xlCalculationManual zu xlCalculationAutomatic bereit enthalten
End Sub
VG
Yal
Anzeige
AW: Code Anpassung
03.12.2022 18:22:48
Thomas
Hallo Yal,
du sagst es. Hab dein Code getestet und der läuft besser und ohne geflacker.
Danke nun auch Dir.
Gruß Thomas
AW: Code Anpassung
03.12.2022 18:43:08
snb 

Sub M_snb()
sp=sheets("reperatur").range("D2:E2")
sn=selection
for j=1 to ubound(sn)
sn(j,1)=replace(sn(j,1),sp(1,1),sp(j,2))
next
Selection=sn
End Sub

Ja, noch besser
03.12.2022 19:18:52
Yal
@Thomas: Das "Geflacker" ist vom "ScreenUpdating" verursacht.
Du schaltest es (in deinem Beitrag von 18:16:14) zwar vor der For-Schleife aus, aber schaltest vor dem "Next" weider ein. Also wirkt er nur beim ersten von 99 mal.
Der Code von @snb ist effektiver, weil die Zwischenergebnisse nicht in das Excelblatt geschrieben werden, was das gesamt verlangsammt.
Es muss dann differenziert werden, ob Selection eine oder mehrere Zellen hat.

Sub Ersetzen_snb()
Dim map 'Array für Mapping-Werte
Dim sel 'Zelle oder Array für Werte der Selectionsbereich
Dim m, r, c 'Lauf-Variablen für jeweils map, Row, Column
'    map = Sheets("reparatur").Range("D2:E100")
map = Sheets(1).Range("D2:E100")
sel = Selection
If Selection.Cells.Count = 1 Then
For m = 1 To UBound(map, 1)
sel = Replace(sel, map(m, 1), map(m, 2))
Next
Else
For r = 1 To UBound(sel, 1)
For c = 1 To UBound(sel, 2)
For m = 1 To UBound(map, 1)
sel(r, c) = Replace(sel(r, c), map(m, 1), map(m, 2))
Next
Next
Next
End If
Selection = sel
End Sub
VG
Yal

Anzeige
AW: Code Anpassung
03.12.2022 21:01:36
Daniel
HI
nutze doch die ERSETZEN-Funktion von Excel.
das spart dir eine Schleife über Selection weil das alle referenzierten Zellen zusammen bearbeitet und du brauchst nur die Schleife über die Zellen des Blattes Reperatur.

dim Zelle as Range
for each Zelle in Sheets("Reparatur").Range("D2:D100")
Selection.Replace Zelle.Value, Zelle.Offset(0, 1).value, lookat:=xlpart
next
ScreenUpdating und Calculation kannst du ausschalten, sollte aber nur wenig Effekt haben.
Gruß Daniel
AW: Code Anpassung
03.12.2022 21:51:18
snb
Verzichte wie möglich auf 'flackernde' Arbeitsblatt Interaktion
Verwende in VBA wo möglich Arrays.

Sub M_snb()
sn=selection
sp= sheets("Reperatur").range("D2:E100")
for j=1 to ubound(sn)
sn(j,1)=replace(sn(j,1),sp(j,1),sp(j,2))
next
selection = sn
End Sub

Anzeige
AW: Code Anpassung
04.12.2022 12:06:00
Thomas
Guten Morgen zusammen,
ich bedanke mich für die vielen Vorschläge. Ich hab sie alle probiert und es kamen Fehler wie bei UBound erwartet Datenfeld oder Index ausserhalb ...
Zellbezüge habe ich klar angepasst zuvor.
Was ich halt jetzt so bei meinen Versuchen festgestellt habe ist, wenn es Ähnlichkeiten gibt in der Tabelle wo ich den Bereich markiere, dann werden manche nicht richtig erkannt und ersetzt.
Das finden sollte wie beim SVerweis erfolgen das es eindeutige Ergebnisse gibt SVERWEIS(Basis!B2;Reperatur!A2:C85;3;FALSCH)
Der Code sollte etwar so aussehen SVerweis(selektierte Zelle, Spalte 2 in Tab Basis!;Reperatur!A2:C85;3;FALSCH) und das Ergebnis ist dann in die selektierte Zelle einzutragen. Dann nächste Zeile darunter bis letzte Zeile in Spalte B.
Aber vorerst ist mir schon weit geholfen und die paar was falsch sind kann ich mit Hand korrigieren.
Habt alle einen schönen 2. Advent
Gruß Thomas T.
Anzeige
AW:Zur Info Ziel fast erreicht
04.12.2022 14:25:29
Thomas 

Sub Makro1()
Dim lngR As Long
lngR = ActiveCell.Row
Cells(lngR + 1, 2).Select
Call Functionstest
End Sub


Function WertRückgabe() As String
WertRückgabe = WorksheetFunction.VLookup(ActiveCell.Value, Sheets("Reperatur").[A2:C85], 3, False)
End Function


Sub Functionstest()
Dim dblVar As String 'Double
dblVar = WertRückgabe
ActiveCell.Value = WertRückgabe
'Debug.Print dblVar
End Sub

AW: AW:Zur Info Ziel fast erreicht
04.12.2022 16:55:08
snb
Deine 'Lösung' stimmt nicht mit deinem Aufgabe Text
Lade mal eine Beispieldatei hoch.
Verzichte in VBA immer auf 'Select' und 'Activate'.
Anzeige
AW: AW:Zur Info Ziel fast erreicht
04.12.2022 18:22:48
Thomas
Hallo snb,
du hast recht. Ich dachte "suchen und ersetzen" würde mir helfen aber jedoch hatte ich festgestellt das nicht alles klar erkannt und ersetzt wurde und so bin ich übergegangen auf die Function und dem SVerweis.
Der Weg ist das Ziel und der kann vielfältig sein. Mein Code ist der Weg Schritt für Schritt aber nun habe ich ihn auch zusammen gestutzt. 5 Stunden Arbeit, Recherche und ich kann stolz sein auf das Ergebnis.
Ich werde dennoch versuchen die Fehlermeldungen als Übung für mich zu beheben und lernen. Danke nochmal.
Gruß Thomas T.
AW: AW:Zur Info Ziel fast erreicht
04.12.2022 19:41:37
Yal
Hallo Thomas,
das Problem mit replace ist die Reihenfolge:
Wenn Du ABC in DEF ändern möchtest, aber in deine Konversionsliste vor ABC einen Eintrag "mache aus BC XY", dann hast Du am Ende XYC.
Aber wir haben alle ganz brav deine originale Fragestellung beantwortet.
VG
Yal
Anzeige
OT: Ihr macht es klasse hier!
05.12.2022 11:10:01
Thomas

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige