Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1296to1300
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

Gruppen einfügen

Gruppen einfügen
14.02.2013 19:24:02
Justus
Hallo cummunity,
Ich habe eine Tabelle mit einem Reiter "Tabelle1", bei der in Spalte A in unregelmäßigen Abständen Gruppen auftauchen.
Für diese Gruppen existieren in einem Reiter "Tabelle2" mehrere Einträge.
Ich möchte nun, dass ein Programm folgendes tut:
a) von Zeile 2 bis letzte Zeile von Spalte A in Reiter "Tabelle1" daraufhin
überprüfen, ob eine der Gruppen aus Reiter "Tabelle2" vorkommt.
b) wenn eine der Gruppen aus Reiter "Tabelle2" gefunden wird, dann sollen in Tabelle1
ba) soviele LeerZeilen eingefügt werden, wie es Einträge in der Gruppe gibt
bb) die Inhalte der Gruppe in Spalte B in die neu eingefügten Zeilen kopiert
werden
c) wenn keine Gruppe gefunden wird, dann soll das Programm eine Zeile weiter springen
und zwar so lange, bis es am Ende von Spalte A angekommen ist.
Zum besseren Verständnis habe ich mal eine Beispiel-Datei vorbereitet.
https://www.herber.de/bbs/user/83913.xlsx
In Tabelle1, Spalte A, sowie Tabelle2 stehen die Ausgangswerte.
In Tabelle1, Spalten D-E stehen die gewünschten Ergebnisse.
Vielen Dank vorab an alle, die sich Zeit für mein Problem nehmen.
Justus

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Gruppen einfügen
14.02.2013 23:44:23
Mustafa
Hallo Justus,
meinst du so ?
Code gehört in ein Modul.
Option Explicit
Sub Gruppieren()
Dim StrWert As String
Dim RngBereich As Range
Dim IntX As Integer, IntY As Integer, IntZ As Integer
Dim LngLetzteZeile1 As Long, LngLetzteSpalte As Long, LngLetzteZeile2 As Long
Dim WksTab1 As Worksheet, WksTab2 As Worksheet
Set WksTab1 = Worksheets("Tabelle1")
Set WksTab2 = Worksheets("Tabelle2")
LngLetzteZeile1 = WksTab1.Cells(WksTab1.Cells.Rows.Count, 1).End(xlUp).Row
LngLetzteSpalte = WksTab2.Cells(1, WksTab2.Cells.Columns.Count).End(xlToLeft).Column
For IntX = 1 To LngLetzteSpalte
StrWert = WksTab2.Cells(1, IntX)
LngLetzteZeile2 = WksTab2.Cells(WksTab2.Cells.Rows.Count, IntX).End(xlUp).Row
For IntY = 1 To LngLetzteZeile1
If WksTab1.Cells(IntY, 1) = StrWert Then
LngLetzteZeile1 = LngLetzteZeile1 + LngLetzteZeile2
For IntZ = LngLetzteZeile2 - 1 To 1 Step -1
WksTab1.Cells(IntY + 1, 1).Rows.Insert
Next
End If
Next
Next
LngLetzteZeile1 = WksTab1.Cells(WksTab1.Cells.Rows.Count, 1).End(xlUp).Row
LngLetzteSpalte = WksTab2.Cells(1, WksTab2.Cells.Columns.Count).End(xlToLeft).Column
For IntX = 1 To LngLetzteSpalte
StrWert = WksTab2.Cells(1, IntX)
LngLetzteZeile2 = WksTab2.Cells(WksTab2.Cells.Rows.Count, IntX).End(xlUp).Row
For IntY = 1 To LngLetzteZeile1
If WksTab1.Cells(IntY, 1) = StrWert Then
For IntZ = LngLetzteZeile2 - 1 To 1 Step -1
WksTab1.Cells(IntY + IntZ, 2) = WksTab2.Cells(IntZ + 1, IntX)
Next
End If
Next
Next
End Sub
Rückmeldung obs Hilft wäre nett.
Gruß aus der Domstadt Köln.

Anzeige
AW: Gruppen einfügen
15.02.2013 01:10:43
Justus
Hallo Mustafa,
Wahnsinn! Du hast es hinbekommen. Es ist genau so wie ich es wollte.
Werde ich mir morgen mal in Ruhe angucken, was du da gezaubert hast.
Vielen Dank + gute Nacht.
Justus

Danke für die Rückmeldung owT
15.02.2013 01:27:46
Mustafa

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige