Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1368to1372
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

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

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

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

Anzeige
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

357 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige