Namenssuche und darunter schreiben

Hallo zusammen,
ich möchte auf einem Tabellenblatt per VBA eine Zelle suchen, der ich vorher einen Namen gegeben hatte.
Wenn ich die Zelle mit dem Namen (z.B. Maschine1) gefunden habe, soll gleich in die Zelle darunter die Zahl 1 eingetragen werden. In die zweite Zeile darunter soll die Zahl 2 eingetragen werden. Das soll so lange fortgeführt werden, bis die vorletzte leere Zelle eine Zahl bekommen hat. Die letzte leere Zelle soll keine Zahl bekommen, denn sie ist nur eine Trennzeile.
Dazu seht ihr am besten meine Beispieldatei.
https://www.herber.de/bbs/user/110172.zip
Im Anschluss daran möchte ich dann die Zelle mit dem Namen Maschine2 suchen und die darunter folgenden Zellen wieder mit einer fortlaufenden Nummerierung versehen, also wieder 1, 2 usw..
Es kann sein, dass ein Name nicht mehr vorkommt, weil die Zelle vorher durch ein anderes Makro gelöscht wurde. Daher sollte der Code berücksichtigen, dass ein Name auch mal nicht gefunden werden könnte.
Natürlich habe ich vorher die Recherche bemüht bevor ich diesen Beitrag schreibe aber leider war zu diesem Problem nichts verwertbares zu finden.
Danke schön und Gruß
Erdoğan
PS: Feedback ist selbstverständlich.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Erdoğan,
zu nachfolgendem Code musst Du Dir noch 2 Überlegungen machen:
1. Wenn nicht klar ist wie viele Maschinen es gibt läuft der Code natürlich ins Unendliche,
da ja auch Namen nicht vorkommen können. Theoretisch kann es also auch eine Maschine10000 geben.
Ich habe hier im Code die maximale Anzahl auf Maschine100 gesetzt.
Das solltest Du großzügig anpassen falls mehr gebraucht werden.
2. Unter der letzten Maschine gibt es keinen "Stopper" für die fortlaufende Nummerierung. Die Nummerierung
würde also die Spalte bis zum Dateiende füllen und das dürfte kaum beabsichtigt sein. Im Moment
läuft die Nummerierung bis 100. Es würde schon eine Zelle mit einem Blanc genügen um die Nummerierung zu stoppen.

Sub Eintragen()
Dim strSearch As String
Dim rng As Range
Dim findRow As Long
Dim findCol As Integer
Dim i As Integer
Dim a As Integer
Application.ScreenUpdating = False
With ActiveSheet
For i = 1 To 100 'Code sucht bis Maschine100, evtl. anpassen
strSearch = "Maschine" & i
Set rng = .UsedRange.Find(What:=strSearch, _
Lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not rng Is Nothing Then
findRow = rng.Row
findCol = rng.Column
For a = 1 To 100 'Nummerierung läuft maximal bis 100, anpassen
If IsEmpty(.Cells(findRow, findCol).Offset(a + 1, 0)) Then
.Cells(findRow + a, findCol) = a
Else
Exit For
End If
Next a
End If
Next i
Set rng = Nothing
End With
End Sub

Gruß
Klaus

Sub Ellipse1_Klicken() Dim i As Long Dim a As Long Dim strSearch As String strSearch = "Maschine" Dim strColumn As String strColumn = "A" 'Suchspalte anpassen Application.ScreenUpdating = False With ActiveSheet For i = 1 To .Cells(Rows.Count, strColumn).End(xlUp).Row If .Cells(i, strColumn) = strSearch Then For a = 1 To 50 'Nummerierung läuft maximal bis 50, anpassen If IsEmpty(.Cells(i, strColumn).Offset(a + 1, 0)) Then .Cells(i + a, strColumn) = a Else Exit For End If Next a End If Next i End With End Sub

Beliebteste Forumthreads (12 Monate)

Namenssuche und darunter schreiben

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread