Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 12:38:40
Formeländerung durch Wechsel von Excel 2021 auf 2019
24.04.2024 12:31:18
Excel - Sverweis mit Wenn-Abfrage kombinieren
24.04.2024 12:16:26
Name von aktuellem VBA-Modul ausgeben
24.04.2024 12:07:15
Werte einer Liste vergleichen und markieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1796to1800
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
1796to1800
1796to1800
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro Anapssung

Makro Anapssung
30.11.2020 16:16:32
Hannah
Ich möchte Preise kopieren und habe ein Makro leider kann ich es nicht anpassen
Ich habe eine Excel Datei und es müssten Preise kopiert und wieder eingefügt werden
in Spalte 12 ist der normale Preis
in Spalte 11 der Sale Preis
wenn Spalte 12 leer ist soll der Preis von Spalte 11 in 12 eingefügt werden und Daten in Spalte 1 gelöscht werden.
beginnen soll da ganze ab Zeile 2
Private Sub Preisprüfen()
Dim StartReihe As Integer
StartReihe = 1 'Eventuell Anpassen je nachdem wo du beginnen willst
Do While Cells(StartReihe, 1)  ""
If Cells(StartReihe, 2) = "" Then 'Überprüfung ob Spalte B leer ist
Cells(StartReihe, 2) = Cells(StartReihe, 1)
End If
StartReihe = StartReihe + 1 'Nächste Zeile prüfen
Loop
End Sub

24
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Anapssung
30.11.2020 16:22:57
ChrisL
Hi
Private Sub Preisprüfen()
Dim StartReihe As Integer
StartReihe = 2 'Eventuell Anpassen je nachdem wo du beginnen willst
Do While Cells(StartReihe, 1)  ""
If Cells(StartReihe, 12) = "" Then 'Überprüfung ob Spalte B leer ist
Cells(StartReihe, 12) = Cells(StartReihe, 11)
Cells(StartReihe, 1).ClearContents
End If
StartReihe = StartReihe + 1 'Nächste Zeile prüfen
Loop
End Sub
cu
Chris
AW: Makro Anapssung
30.11.2020 16:25:22
ralf_b 

Private Sub Preisprüfen()
Dim StartReihe As Integer
StartReihe = 2 'Eventuell Anpassen je nachdem wo du beginnen willst
Do While Cells(StartReihe, 1)  ""
If Cells(StartReihe, 12) = "" Then 'Überprüfung ob Spalte 12 leer ist
Cells(StartReihe, 12).Value = Cells(StartReihe, 11).Value
Cells(StartReihe, 1).ClearContents
End If
StartReihe = StartReihe + 1 'Nächste Zeile prüfen
Loop
End Sub

Anzeige
AW: Makro Anapssung
30.11.2020 16:53:02
Edmund
Hallo Hannah
Vielleicht noch eine Anmerkung.
Du hast jetzt zwei Lösungen bekommen die tadellos funktionieren.
Es sollte nur folgendes klar sein.
Dein ursprünglicher Code beinhaltet eine Schleife, welche stur die 1. Spalte abarbeitet, bis sie auf die erste leere Zelle trifft und dann stoppt.
Die angepasste Lösung nun löscht wie gewünscht Zellen der 1. Spalte.
Heißt, solltest Du das Makro irgendwann ein zweites Mal ausführen und die Spalte A ist nicht durchgehend mit Werten befüllt, wird das Makro nicht bis zum Ende durchlaufen sondern bei der ersten leeren Zelle stoppen.
Nur so als Hinweis.
Viele Grüße
Edmund
Anzeige
AW: Makro Anapssung
30.11.2020 19:32:58
Hannah
ich habe das Makro gespeichert, leider erscheint es nicht in der Auswahl aber im Modul1 ist der Code vorhanden wenn ich auf VisualBasic gehe
AW: Makro Anapssung
30.11.2020 19:40:57
peterk
Hallo
Nimm "Private" raus, dann kannst Du es auch sehen
Peter
AW: Makro Anapssung
30.11.2020 19:49:32
Hannah
das hat Funktioniert, vielen dank. Nun habe ich das makro ausgeführt aber es tut sich nix
AW: Makro Anapssung
30.11.2020 22:26:55
ralf_b
Tchja Hannah,
das kann einige Gründe haben. Aber mit der Aussage kann man wenig anfangen.
Und übrigens das mit dem private macht mich stutzig. Ich ging davon aus das du das Makro in der ursprünglichen Version schon mal so benutzt hast. Zudem verweise ich auf Edmunds Hinweis. HAst du diesen berücksichtigt?
Gruß
RB
Anzeige
AW: Makro Anapssung
30.11.2020 23:50:09
Hannah
Ja hatte das alte alles gelöscht gehabt und eure eingefügt und dann kam es in der Auswahl nicht mehr.
Habe auch Edmunds Antwort gelesen. aber wenn gleich in der 2 Zeile wo das Makro anfangen müsste zu arbeiten so ein Datensatz vorhanden ist was geändert werden müsste und es aber nicht geht. So langsam verzweifel ich.
AW: Makro Anapssung
01.12.2020 08:42:33
ralf_b
naja dann muß das Ende der schleife eben umgebaut werden 

Dim StartReihe As Integer, lLetze as Long
lLetzte =  Cells(rows.count , 2).end(xlup).row
'2 ist die Spalte "B" weil in "A" ja auch die Zelle im letzten Datensatz evtl. leer sein könnte. _
StartReihe = 1 'Eventuell Anpassen je nachdem wo du beginnen willst
Do While StartReihe

Anzeige
AW: Makro Anapssung
01.12.2020 11:29:25
Hannah
Hallo
jetzt blicke ich gar nicht mehr durch.
Hatte mir jetzt diese Makro gebastelt aber es kommt ein Fehler
Sub Preisprüfen()
Dim StartReihe As Integer, lLetze As Long
lLetzte = Cells(Rows.Count, 12).End(xlUp).Row
StartReihe = 2 'Eventuell Anpassen je nachdem wo du beginnen willst
Do While StartReihe  ""
If Cells(StartReihe, 12) = "" Then 'Überprüfung ob Spalte 12 leer ist
Cells(StartReihe, 12).Value = Cells(StartReihe, 11).Value
End If
StartReihe = StartReihe + 1 'Nächste Zeile prüfen
Loop
End Sub

AW: Makro Anpassung
01.12.2020 17:05:51
ralf_b
pardon, ein Schreibfehler. die Variablen sollten übereinstimmen. 
lLetze As Long
lLetzte = Cells(Rows.Count, 12).End(xlUp).Row
Do While StartReihe

Anzeige
AW: Makro Anpassung
01.12.2020 22:15:21
Hannah
Könntest du mir das komplette Makro geben?
Ich weiß jetzt nicht was ich löschen muss oder hinzufügen.
Vielen vielen Dank
AW: Makro Anpassung
01.12.2020 22:48:01
ralf_b
das fettgedruckte "t" muß erstmal weg. dann nochmal probieren.
AW: Makro Anpassung
01.12.2020 23:47:42
Hannah
das ist jetzt mein code, aber es kommt ein fehler - do ohne loop
Sub Preisprüfen()
Dim StartReihe As Integer, lLetze As Long
lLetzte = Cells(Rows.Count, 12).End(xlUp).Row
StartReihe = 2 'Eventuell Anpassen je nachdem wo du beginnen willst
Do While StartReihe  ""
If Cells(StartReihe, 12) = "" Then 'Überprüfung ob Spalte 12 leer ist
Cells(StartReihe, 12).Value = Cells(StartReihe, 11).Value
End If
StartReihe = StartReihe + 1 'Nächste Zeile prüfen
Loop
End Sub

Anzeige
AW: Makro Anpassung
02.12.2020 00:02:06
ralf_b 

das bleibt   Do While StartReihe  ""
und hier  lLetzte =   das  t nach dem lLetz weg.

AW: Makro Anpassung
02.12.2020 12:12:31
Hannah
Alle Fehler weg aber leider führt das Makro nichts aus.
Sub Preisprüfen()
Dim StartReihe As Integer, lLetze As Long
lLetze = Cells(Rows.Count, 12).End(xlUp).Row
StartReihe = 2 'Eventuell Anpassen je nachdem wo du beginnen willst
Do While StartReihe

AW: Makro Anpassung
02.12.2020 13:21:40
Edmund
Moin Hannah
Kannst Du Deine Datei mal hochladen?
Es ist wesentlich einfacher, wenn man die Struktur der Tabelle vor Auge hat.
Viele Grüße
Edmund
Anzeige
AW: Makro Anpassung
02.12.2020 17:35:52
Edmund
Hallo Hannah
Kaum hat man die Datei, schon wird einiges klar.
Das kann so nicht gehen, da es gleich mehrere Fehler gibt
1.
Im aktuellen Makro wird die letzte Zeile der Spalte 12 ermittelt.
Das funktioniert nicht korrekt, da diese ja Lücken aufweist.
Das Ermitteln muss über eine Spalte erfolgen, die zuverlässig ausgefüllt ist. z.B. 10?
2.
Die leeren Felder in Spalte 12 sind nicht leer, sondern da ist jeweils ein Leerzeichen drin.
Dadurch wird die Zelle vom Makro nicht als leer erkannt.
3.
Die Zellen mit den Preisen sind tatsächlich 3- Zeilig.
erst ein Leerzeichen, Zeile 2 enthält den Preis, Zeile 3 wieder ein Leerzeichen.
Das führt auch zu Problemen, wenn man nur den Inhalt überträgt.
Wenn sich das nicht vermeiden lässt, muss man mit Copy & paste arbeiten.
Ich muss jetzt leider los und kann mich erst später nochmals dransetzen, wenn kein anderer schneller ist :)
Viele Grüße
Edmund
Anzeige
AW: Makro Anpassung
02.12.2020 17:38:35
peterk
Hallo
Deine Zellen sind nicht leer ("") sie beinhalten ein Leerzeichen daher passiert auch nichts. Du Kannst folgendes machen (TRIM entfernt führende und nachfolgende Leerzeichen):
If Trim(Cells(StartReihe, 12)) = "" Then
Was mir noch aufgefallen ist: Deine Preise haben alle ein Linefeed am Anfang und am Ende
AW: Makro Anpassung
02.12.2020 18:40:16
ralf_b
so Hannah, nachdem du uns gezeigt hast was an den Daten murks ist, habe ich dir mal wieder etwas gebastelt.
zur Erläuterung:
ich suche in den beiden Spalten 11 und 12 ob ein € Zeichen drin ist und ob ein Komma drin ist.
Jeweils wird der Teil davor und danach abgeschnitten. Zwei Nachkommastellen bleiben aber erhalten.
Abschliessend wird in spalte 12 geschaut ob dort leer ist (auch wenn noch ein Leerzeichen drin ist, klappt das).
das einzig Unschöne an der Sache ist, das der Text immer noch keine Zahl ist. Kommt aber drauf an was du noch damit vorhast. 
Sub Preisprüfen()
Dim StartReihe As Integer, lLetzte As Long
Dim res As Integer
lLetzte = Cells(Rows.Count, 11).End(xlUp).Row
StartReihe = 2 'Eventuell Anpassen je nachdem wo du beginnen willst
Do While StartReihe  0 Then Cells(StartReihe, 12).Value = _
Right(Cells(StartReihe, 12), Len(Cells(StartReihe, 12).Value) - res + 1)
res = 0
res = InStr(1, Cells(StartReihe, 12).Value, ",")
If res > 0 Then Cells(StartReihe, 12).Value = Left(Cells(StartReihe, 12), res + 2)
res = 0
res = InStr(1, Cells(StartReihe, 11).Value, "€")
If res > 0 Then Cells(StartReihe, 11).Value = _
Right(Cells(StartReihe, 11), Len(Cells(StartReihe, 11).Value) - res + 1)
res = 0
res = InStr(1, Cells(StartReihe, 11).Value, ",")
If res > 0 Then Cells(StartReihe, 11).Value = Left(Cells(StartReihe, 11), res + 2)
If Trim(Cells(StartReihe, 12)) = "" Then 'Überprüfung ob Spalte 12 leer ist
Cells(StartReihe, 12).Value = Cells(StartReihe, 11).Value
End If
StartReihe = StartReihe + 1 'Nächste Zeile prüfen
Loop
End Sub

Anzeige
update............... danke Edmund
02.12.2020 19:25:17
ralf_b
das müßte noch ausgetauscht werden wegen dem Löschen in Spalte A.

If Trim(Cells(StartReihe, 12)) = "" Then 'Überprüfung ob Spalte 12 leer ist
Cells(StartReihe, 12).Value = Cells(StartReihe, 11).Value
Cells(StartReihe, 1).ClearContents
End If

AW: Makro Anpassung
02.12.2020 19:13:45
Edmund
Hab den Code mal minimiert
so würde meine Lösung aussehen
Sub Preisprüfen()
Dim i As Integer
For i = 2 To Cells(Rows.Count, 12).End(xlUp).Row
If Cells(i, 12) = " " Then
Cells(i, 11).Copy
Cells(i, 12).PasteSpecial
End If
Next i
End Sub
Voraussetzung:
Die Leerzeichen müssen auch weiterhin vorhanden sein.
Wenn die zuverlässig gesetzt werden, kann auch die Spalte 12 zum Zählen verwendet werden.
und wie war das jetzt mit der 1 Spalte?
Soll da jetzt noch was gelöscht werden?
Wenn ja, müsste vor das End If noch folgende Zeile:
Cells(i, 1).ClearContents
An Deiner Datei wird nun nichts verändert, was aber bedeutet, dass das Weiterverarbeiten der Zahlen (so das gewünscht ist) schwierig werden kann.
Viele Grüße
Edmund
AW: Makro Anapssung
03.12.2020 10:26:03
Hannah
Ich bedanke mich bei allen für eure Hilfe
Es hat geklappt, den Rest kann ich über Filter erledigen.
Lieben lieben Dank

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige