Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1232to1236
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

Makrolösung

Makrolösung
Fritz_W
Hallo VBA-Experten,
ich würde gerne per Makro für die ersten 100 Spalten des aktiven Tabellenblatts (Spalten A bis CV)folgendes erledigen lassen:
In den Zellen der Zeile 2 der aktiven Tabelle, also im Zellbereich A2:CV2) stehen die Namen von einzelnen Tabellenblättern der Arbeitsmappe. Es sollte also für jede Spalte A bis CV der aktiven Tabelle zunächst immer in die Tabelle gewechselt werden, die den in Zeile 3 stehenden Namen trägt, steht in A3 'Tabelle1', sind also die Daten der 'Tabelle1' für die nachfolgend beschriebenen Aktivitäten relevant.
In dieser Tabelle (im Beispiel 'Tabelle1') sollte in Spalte B der Begriff gesucht werden, der in Zeile 3 der Ausgangstabelle (im Beispiel A3) steht. Wird der erste Begriff gefunden, sollte der Inhalt aus der Spalte A dieser Zeile in die Zeile 4 der Ausgangstabelle geschrieben werden, wird der Begriff in der Spalte B mehrmals gefunden, sollten die Inhalte der betreffenden Zelle in Spalte A in der aktiven Tabelle ab Zeile 4 fortlaufend erfasst werden.
Beispiel (bezogen auf die Spalte A der Ausgangstabelle):
Im aktiven Tabellenblatt steht in der Zelle A2 'Tabelle1' und in Zelle A3 'Hund'. Dann sollte im Tabellenblatt 'Hund' für jeden in einer Zelle der Spalte B auftauchenden 'Hund' der Inhalt der Zelle aus Spalte A dieser Tabelle in die Ausgangstabelle in Spalte A fortlaufend ab A4 geschrieben werden.
Beispiel: Im Tabellenblatt 'Tabelle1' steht 'Hund' in den Zellen B6, B19 und B34. Dann sollte in der aktiven Tabelle in A4 der Inhalt der Zelle A6, in A5 der Inhalt aus A19 und in A6 der Inhalt aus A34 (jeweils aus Tabelle1) stehen.
Das Ganze sollte dann anschließend (entsprechend) für die nächsten 99 Spalten (B bis CV) der aktiven Tabelle durchgeführt werden.
Ich hoffe, ich habe mein Anliegen nachvollziehbar dargelegt (falls nicht ggf. bitte melden, gleichzeitig bitte ich um Nachsicht) und freue mich über jede Form von Hilfe.
lg
Fritz

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

Betreff
Benutzer
Anzeige
AW: Makrolösung
28.10.2011 18:56:13
Christian
Hallo Fritz,
... ersten 100 Spalten des aktiven Tabellenblatts ....
Du solltest so was nicht mit dem jeweils aktiven Tabellenblatt ausführen, sondern jenes Tabellenblatt in dem die Namen und Suchbegriffe stehen konkret benennen. (in meinem Bsp. heißt dieses Tabellenblatt "Suche").
Der Code löscht im Tabellenblatt "Suche" alle Einträge ab Zeile 4 - teste also erst mal in einer Kopie.

Option Explicit
Sub TestIt()
Dim wks As Worksheet
Dim strWks$, strFnd$, strAddr$
Dim i&, k&
Dim rngFnd As Range
Dim blnWks As Boolean
With ThisWorkbook.Sheets("Suche")
.Rows(4).Resize(.Rows.Count - 3).ClearContents
For i = 1 To 100
k = 4
blnWks = False
strWks = .Cells(2, i)
For Each wks In ThisWorkbook.Worksheets
If wks.Name = strWks Then
blnWks = True
Exit For
End If
Next
If blnWks Then
Set wks = ThisWorkbook.Sheets(strWks)
strFnd = .Cells(3, i).Text
Set rngFnd = wks.Columns(2).Find(strFnd, wks.Cells(Rows.Count, 2), xlValues, 1)
If Not rngFnd Is Nothing Then
strAddr = rngFnd.Address
Do
.Cells(k, i) = wks.Cells(rngFnd.Row, 1)
Set rngFnd = wks.Columns(2).FindNext(rngFnd)
k = k + 1
Loop While Not rngFnd Is Nothing And rngFnd.Address  strAddr
End If
Else
.Cells(4, i) = "Tabelle nicht vorh."
End If
Next
End With
Set rngFnd = Nothing
Set wks = Nothing
End Sub

Gruß
Christian
Anzeige
Genial
28.10.2011 20:31:58
Fritz_W
Hallo Christian,
vielen Dank, funktioniert wie gewünscht. Einfach Klasse.
Werde mich morgen noch mal melden.
Schönen Abend noch
Fritz
AW: Makrolösung
29.10.2011 11:18:17
Fritz_W
Hallo Christian,
an meiner Beurteilung deines Codes hat sich auch nach mehrmaligem Testen nichts geändert!!
Ich habe aber noch eine Frage bzw. deiner Anmerkung, warum man das nicht im 'aktiven Tabellenblatt' ausführen sollte. Da ich das Makro evtl. aus mehreren (Such-) Tabellen der Arbeitsmappe ausführen lassen wollte, wäre eine derartige Lösung für mich von Vorteil gewesen.
Nochmals vielen Dank für Deine Hilfe.
mfg
Fritz
Anzeige
AW: Makrolösung
29.10.2011 11:47:55
Christian
wenn du bei Start des Scripts z.B. grade ein Tabellenblatt aktiviert hast, in dem deine Daten stehen, werden diese überschrieben. Deshalb ist "ActiveSheet" gefährlich.
Du könntest aber z.B die Namen der "(Such-) Tabellen" in ein Array schreiben und zuerst prüfen, ob der Name des aktiven Blatts in dieser Liste steht. Wenn ja, dann weiter im Code, sonst "Exit Sub".
Gruß
Christian
AW: Makrolösung
29.10.2011 12:17:31
Fritz_W
Hallo Christian,
vielen Dank für die Ausführungen. Ich dachte mir, dass das sicherheitstechnisch bedingt ist.
Wenn nicht zu aufwändig, würde ich mich über eine beispielhafte Anspassung des Codes an die Alternative (Array) freuen. z.B. mit den drei (Such-)'Tabellen Suche1, Suche2, Suche3
Viele Grüße
Fritz
Anzeige
AW: Makrolösung
29.10.2011 12:41:03
Christian
ungetestet:
ersetzten bzw. ergänze die fett markierten Einträge:

Option Explicit
Sub TestIt()
Dim wks As Worksheet
Dim strWks$, strFnd$, strAddr$
Dim i&, k&
Dim rngFnd As Range
Dim blnWks As Boolean
    Dim vntWks
vntWks = Array("Suche1", "Suche2", "Suche3")
With ThisWorkbook.ActiveSheet
If IsError(Application.Match(.Name, vntWks, 0)) Then Exit Sub
.Rows(4).Resize(.Rows.Count - 3).ClearContents
For i = 1 To 100
'... usw
'... usw

Gruß
Christian
Super
29.10.2011 18:03:26
Fritz_W
Hallo Christian,
vielen herzlichen Dank.
mfg
Fritz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige