Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Zellen nach Bedingung mit Wert beschreiben

Forumthread: VBA Zellen nach Bedingung mit Wert beschreiben

VBA Zellen nach Bedingung mit Wert beschreiben
05.07.2014 21:41:01
uwe Nier

Hallo ich habe mehrere identisch aufgebaute Tabellen mit mehr jeweils als 5000 Zeilen
Ein Beispiel ist wie folgt aufgebaut:
https://www.herber.de/bbs/user/91392.xlsx
In der Spalte B liegt mein Problem:
Beispiel
In A3 steht das Wort Paket, und in B3 ein beliebiger Text
Wenn in A4 das Wort Position steht, muss in B4 der Text aus B3 mit .1 erweitert werden.
Wenn in A5 auch das Wort Position steht, muss in B5 der Text aus B3 mit .2 erweitert werden.
Die Erweiterung mit .1 .2 .3 usw muss so lange fortgesetzt werden, bis in Spalte A wieder das Wort Paket oder Titel auftaucht.
Dann muss in der Zeile nach Paket in A in Spalte B der Text aus B-1 mit .1 erweitert und dort eingetragen werden.
Falls in A das Wort Position steht und in B bereits eine falsche Eintragung steht, muss B ueberschrieben werden.
In meinem Beispiel ist die Aufgabe in den Registern Vorher / Nachher zu sehen.
Da die Pakete unterschiedlich lang sind bzw. auch mehrere Tabellen derart ueberarbeitet werden muessen ist der Aufwand die Nummereirung per Hand durchzufuehren sehr gross.
Falls es nicht zu viel verlangt ist, waere es noch besser wenn das Makro eine neue Tabelle mit dem Namen "Kopie von ..." erzeugt.
Vielen Dank fuer Eure Hilfe
MfG
Hyperbolikus

Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Zellen nach Bedingung mit Wert beschreiben
06.07.2014 02:10:51
Matthias L
Hallo
Vorher:
Test

oder so ...
06.07.2014 04:37:19
Matthias L

Option Explicit
Sub UweNier2()
Dim x&, ii&, LoLezte&
Dim MyShName$
MyShName = ActiveSheet.Name
Sheets(MyShName).Copy After:=Sheets(MyShName)
ActiveSheet.Name = "Kopie von " & MyShName
LoLezte = Cells(Rows.Count, 1).End(xlUp).Row
For x = 4 To LoLezte
If Cells(x, 1) = "Position" Then
ii = ii + 1
Cells(x, 2) = Cells(x - ii, 2) & "." & ii
Else
ii = 0
End If
Next
End Sub
Gruß Matthias

Anzeige
AW: oder so ...
06.07.2014 09:00:52
Uwe Nier
Danke Matthias für die schnelle Hilfe.
Das Makro funktioniert einwandfrei
mit freundlichen Grüßen
Uwe

mit Prüfung auf bereits vorhandenen Blattnamen
06.07.2014 09:02:55
Matthias L
Hallo
Option Explicit
Sub FuerUweNier3()
Dim x&, ii&, LoLezte&
Dim MyShName$, Wks As Worksheet
MyShName = ActiveSheet.Name
For Each Wks In ThisWorkbook.Worksheets
If Wks.Name = "Kopie von " & MyShName Then
MsgBox "Kopie von " & MyShName & " ist schon vorhanden"
Exit Sub
End If
Next
Sheets(MyShName).Copy After:=Sheets(MyShName)
ActiveSheet.Name = "Kopie von " & MyShName
LoLezte = Cells(Rows.Count, 1).End(xlUp).Row
For x = 4 To LoLezte
If Cells(x, 1) = "Position" Then
ii = ii + 1
Cells(x, 2) = Cells(x - ii, 2) & "." & ii
Else
ii = 0
End If
Next
End Sub
Gruß Matthias

Anzeige
AW: mit Prüfung auf bereits vorhandenen Blattnamen
06.07.2014 16:33:37
Uwe Nier
Danke,
habe sofort geändert.
Das Makro arbeitet einwandfrei
MfG
Uwe

;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige