Verknüpfungen mit Vergleich oder Makro

Option Explicit Sub Karen() Dim Inhalt As Worksheet, Übersicht As Worksheet Dim Text1$, Text2$, Text3$, Text4$, Text5$, Text6$, Text7$, Gesamt$ Set Inhalt = Worksheets("Inhalt"): Set Übersicht = Worksheets("Übersicht GP") Dim Zähler& For Zähler = 3 To Inhalt.Cells(Rows.Count, 13).End(xlUp).Row Text1 = IIf(Übersicht.Cells(Zähler, 11) = "x", Übersicht.Cells(2, 11) & ", ", "") Text2 = IIf(Übersicht.Cells(Zähler, 12) = "x", Übersicht.Cells(2, 12) & ", ", "") Text3 = IIf(Übersicht.Cells(Zähler, 13) = "x", Übersicht.Cells(2, 13) & ", ", "") Text4 = IIf(Übersicht.Cells(Zähler, 14) = "x", Übersicht.Cells(2, 14) & ", ", "") Text5 = IIf(Übersicht.Cells(Zähler, 15) = "x", Übersicht.Cells(2, 15) & ", ", "") Text6 = IIf(Übersicht.Cells(Zähler, 16) = "x", Übersicht.Cells(2, 16) & ", ", "") Text7 = IIf(Übersicht.Cells(Zähler, 17) = "x", Übersicht.Cells(2, 17), "") Gesamt = Text1 & Text2 & Text3 & Text4 & Text5 & Text6 & Text7 Inhalt.Cells(Zähler, 14) = Gesamt Next Zähler End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Karen,
hatte deine einsame und offene Anfrage gesehen und mich mit deiner Beispieltabelle unter Nichtbeachtung des geposteten Makros beschäftigt. Nun, nach Karen suchend, stelle ich fest, dass deinem "Gestern/Heute" ein Riesenthread zugrundeliegt. Dachte aber, es geht i.W. um die optisch richtige Zusammenstellung der Lehrgangsbezeichnungen anhand der x, also um den Aufbau "einzelliger" Listentexte. Mit dergleichen hatte ich mich schon früher beschäftigt und verfüge deshalb über diverse Funktionen, die ich hier aber nicht so ohne weiteres Posten kann. Deshalb habe ich für dieses Problem eine Lösung gefunden, die einerseits auf einem Trick von Boris, der 2 Einträge in die Namensliste erfordert, und andererseits auf einer damit kombinierten Textfunktion von mir basiert. Letztere ist kurz genug, um sie oder eine Ableitung aus ihr hier posten zu können. Ist mir jetzt aber schon zu spät. Also melde dich hier noch mal bei Interesse, dann wird's morgen Abend was.
Gruß Luc :-?

Hallo Karen,
hier nun endlich die Antwort (hatte vorher absolut keine Zeit):
Dein Problem ließ sich für mich recht einfach mit Hilfe 2er von mir schon vor geraumer Zeit kreierten udF (=nutzerdefinierte Funktion) per Eintrag in die relevanten Zellen lösen:
=ChainOn(ChooseIn('Übersicht GP'!K$2:Q$2;'Übersicht GP'!K3:Q3;"x";0);", ";1)
Da ich dir diese leider nicht zur Verfügung stellen kann (zu umfangreich und interne Benutzung weiterer udF), habe ich nach einer anderen Lösung für dich gesucht und mit =ListOn(XText;", ";1) auch gefunden. Da es sich hierbei ebenfalls um eine udF handelt, stelle ich dir anschließend den Code zur Verfügung. XText ist ein Name in der Namensliste. Hier musst du wie folgt vorgehen:
in Namensliste einfügen, während Zelle, in der 1.Listentext erscheinen soll, markiert ist (für K = Kennung erster, Q = Kennung letzter signifikanter Spalte; 'Übersicht GP'!K$2:Q$2 kann durch BName Modulname ersetzt werden):
XWahl Anmerkung: Bitte beachten - Inhalt ist ein Text!
="WENN('Übersicht GP'!K"&ZEILE(Inhalt!3:3)&":Q"&ZEILE(Inhalt!3:3)&"=""x"";'Übersicht GP'!K$2:Q$2;"""")"
XText Anmerkung: Die Funktion im Inhalt wirkt nur in der Namensliste!
=AUSWERTEN(XWahl)
So, damit hättest du die Voraussetzungen erfüllt. Nun noch den Funktionscode in ein normales Modul deines Projektes eintragen. Wenn du diese und andere udF und Prozeduren ständig zur Verfügung haben willst, solltest du sie in einer separaten Mappe speichern. Diese machst du zum AddIn (Endung .xla) und speicherst sie am besten im Unterordner Makro (nicht Macros = Word!) von Office. Wenn du AddIns in Excel aktivierst, sollte er immer mitstarten, so dass dir im Formelassistenten die udF angezeigt wdn. Falls erforderlich, kannst du aber auch im jeweiligen VBA-Projekt (Arbeitsmappe - Editor) direkt einen Verweis auf dieses AddIn anbringen. Übrigens: AddIn-Mappen bleiben unsichtbar, auch wenn sie gestartet wdn. Darin enthaltene normale Prozeduren wdn nirgends angezeigt.
So, jetzt aber noch der Code:
Rem Fkt listet (unterschiedl) ZellInhalte bzw die Matrixwerte von Bereich als String
' Autor: L.Schuller - Vs 1.0 special - Erstpublikation : 20050501 www.herber.de


Function ListOn(ByVal Bereich, Optional ByVal LiTrZ, Optional ByVal oLeer)
Dim i As Long, j As Long, k(1, 1) As Long
If IsMissing(LiTrZ) Then
LiTrZ = " "
End If
If IsMissing(oLeer) Then
oLeer = False
Else: oLeer = CBool(oLeer)
End If
If ActiveCell.HasArray Then
k(0, 0) = LBound(Bereich): k(0, 1) = UBound(Bereich)
k(1, 0) = LBound(Bereich, 2): k(1, 1) = UBound(Bereich, 2)
For i = k(0, 0) To k(0, 1)
For j = k(1, 0) To k(1, 1)
If oLeer Then
If Bereich(i, j) <> "" Then
ListOn = ListOn & LiTrZ & Bereich(i, j)
End If
Else: ListOn = ListOn & LiTrZ & Bereich(i, j)
End If
Next j
Next i
ListOn = Mid(ListOn, Len(LiTrZ) + 1)
ElseIf IsArray(Bereich) Then
k(0, 0) = LBound(Bereich): k(0, 1) = UBound(Bereich)
For i = k(0, 0) To k(0, 1)
If oLeer Then
If Bereich(i) <> "" Then
ListOn = ListOn & LiTrZ & Bereich(i)
End If
Else: ListOn = ListOn & LiTrZ & Bereich(i)
End If
Next i
If ListOn <> "" Then
ListOn = Mid(ListOn, Len(LiTrZ) + 1)
End If
Else: ListOn = "#MATRIX!"
End If
End 

Function </code>
Viel Erfolg (den bitte melden!) und Gruß
Luc :-?

Beliebteste Forumthreads (12 Monate)

Verknüpfungen mit Vergleich oder Makro

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread