Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1824to1828
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 Bedingtes Einfügen von Zeilen

VBA Bedingtes Einfügen von Zeilen
09.04.2021 15:30:56
Zeilen
Hallo guten Tag zusammen,
ich habe ein etwas größeres VBA-Problem, bei dem ich nicht wirklich weiterkomme. Meine VBA-Erfahrung beschränkt sich leider auf den Recorder und kleinere Sachen.
Was das Makro tun soll:
- Makro soll Zeile für Zeile eine Excel-Tabelle durchgehen
- Wenn in einer bestimmten Spalte (in meiner Beispieldatei Spalte2) ein Wert ist, soll das Makro in eine zweite Tabelle gehen ("Subprojekte" in meiner Beispieldatei) und diese nach zugehörigen Werten durchforsten. Wurden z.B. zwei Übereinstimmungen gefunden, sollen in der Ursprungsdatei zwei Zeilen eingefügt werden mit dem Inhalt der zwei gefundenen Matches.
Ist so etwas möglich?
Datei: https://www.herber.de/bbs/user/145414.xlsx
VG
Florian

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Bedingtes Einfügen von Zeilen
09.04.2021 16:12:16
Zeilen
Hallo Florian,
teste mal:
Option Explicit
Public Sub InsertSubprojects()
Dim lngRow As Long, lngCounter As Long
Dim strFirstAddress As String
Dim objCell As Range
Application.ScreenUpdating = False
With Tabelle1
For lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Not IsEmpty(.Cells(lngRow, 2).Value) Then
Set objCell = Tabelle2.Columns(1).Find(What:=.Cells(lngRow, 2).Value, _
After:=Tabelle2.Cells(1, 1), LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=True)
If Not objCell Is Nothing Then
lngCounter = 0
strFirstAddress = objCell.Address
Do
lngCounter = lngCounter + 1
.Rows(lngRow + lngCounter).Insert
Call objCell.Resize(1, 2).Copy(Destination:= _
.Cells(lngRow + lngCounter, 2))
Set objCell = Tabelle2.Columns(1).FindNext(After:=objCell)
Loop Until objCell.Address = strFirstAddress
Set objCell = Nothing
End If
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk
Anzeige
AW: VBA Bedingtes Einfügen von Zeilen
09.04.2021 16:29:39
Zeilen
Hallo Nepumuk,
Wahnsinn, danke. Läuft prima.
Werde das nutzen. :-)
VG und schönes Wochenende.
Florian

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige