Herbers Excel-Forum - das Archiv

Auflistung aus 0/1 Matrix


Betrifft: Auflistung aus 0/1 Matrix
von: Lukas Pa

Geschrieben am: 07.08.2016 15:17:54

Guten Tag
Ich habe folgendes Problem: Ich habe eine Datenbasis mit einer Spalte für User und sieben Spalten (für jeden Wochentag) mit der Angabe 1 (im Dienst) und 0 (nicht Anwesend).
Beispieldatei (es geht um die das Worksheet "GenData":

Die Datei https://www.herber.de/bbs/user/107450.xlsm wurde aus Datenschutzgründen gelöscht


Nun hätte ich gerne eine Auflistung in der Art:
Montag Frühdienst:
ID1
ID3
ID7
ID9
Montag Spätdienst:
ID2
ID3
ID12
ID20
...

Mit dem SVERWEIS komme ich nicht weiter und alle Schleifenkonstruktionen welche ich erstellt haben liefern mir kein Resultat, bzw. keines welches ein untereinanderstehendes Ergebnis lifert.
Vielen Dank für eure Hilfe
Lukas

Betrifft: Würde das deinen Intentionen entsprechen, ...
von: Luc:-?

Geschrieben am: 07.08.2016 16:58:31
…Lukas?
Userbild
Hier wurden 2 UDFs verwendet, NoErrRange und DataSet jeweils in ihrer aktuellen Version 1.3. Beide sind im Archiv enthalten, allerdings nicht in der hier benötigten Version. Die 2. wird dort (bzw Archiv) veröffentlicht, die 1. folgt unten.
Die grauen Flächen kaschieren #NV-Anzeigen, die sich daraus ergeben, dass die EinzelVektoren nicht immer gleichlang sind, was an der Anzahl im SpaltenKopf zu erkennen ist. Man kann sie vermeiden, indem man pro Spalte nur die dort angezeigte ZeilenAnzahl auswählt, wenn man die MatrixFml über die Zeilen anlegt.
Man kann natürlich auch alles auf 1× so berechnen, aber das würde kompliziertere Fmln erfordern, u.a. weil DataSet idR nur Vektoren verarbeitet.
Public Enum cxTriState: cxAsUsed = -2: cxTrue: cxFalse: cxCTrue: End Enum
Rem Erzeugt ggf 1 unzusammenhängd Bereich (MehrfachAuswahl) aus Bezug lt Arg1
'   ohne darin uU enthaltene FehlerWerte; hilfreich b.Fktt, d.nur Bereiche o.
'   FWerte, aber auch unzusammhängende verarbeiten können, bspw TEILERGEBNIS;
'   Datenfeld-verarbeitde Fktt kommen so idR ohne MxFmlForm aus (außer b.Arg3
'   als DFeld); nur 1 Zelle als Arg1 kn ggf F-Wert liefern, b.VektorForm wird
'   auch b.solitärer FktsVerwendg in (Mx-)Fmln ggf vollständ Ergebnis gelieft
'   (außer uU b.entstandm unzusammhgd Bereich), b.MatrixForm könn d.Werte idR
'   m.INDEX/Var2 aus d.unzusammhgd ErgebnBereich gelesen wdn; m.Arg2=WAHR/<>0
'   wird d.Ergebn auf sichtbare Zellen beschränkt, wobei dies b.Ausblenden d.
'   Zelle m.der d.Fkt enthaltenden Fml dort Anzeige d.StandardFWerts bewirkt;
'   in Arg3 kn auf 1 Bereich m.WahrhWerten gleicher Größe wie Arg1 vwiesen or
'   1 glchgroß Datenfeld (MxKonst oder Ausdruck) angegeben wdn, wird 0/FALSCH
'   angegeben, macht Arg2=1/WAHR d.Fkt nur volatil!
'   Achtung! Fkt benött b.ggf verlangter AutoAktualisierg d.NichtBerücksichtg
'   ausgeblendeter Zellen d.Auslösg d.Neuberechng ([F9] bzw Edit 1er beliebig
'   Zelle - v.Arg2 abhängig: WAHR/<>0 ->partielle Volatilität zur Erzielg dss
'   speziellen Verhaltens; Fkt verwendet Enumeration cxTriState (anlegen)!
'   Vs1.3 -LSr.CyWorXxl -cd:20150710 -1pub:20150721herber(1.2) -lupd:20151114t
Function NoErrRange(Bereich As Range, Optional ByVal nurVisZ As Boolean, _
Optional ByVal ZusKrit) As Range
Dim cct As Long, cif As Long, cix As Long, rct As Long, rix As Long, rif As Long, _
tix As Integer, hasCrits As cxTriState, tmpR(2) As Range, xZ As Range, zK As Range
Application.Volatile nurVisZ: On Error GoTo ex
If IsMissing(ZusKrit) Then ZusKrit = True
With Bereich
If .Cells.Count = 1 Then
If IsError(Bereich) Then Exit Function
If nurVisZ Then
If Not (.EntireRow.Hidden Or .EntireColumn.Hidden) Then _
Set tmpR(0) = Bereich
Else: Set tmpR(0) = Bereich
End If
If Not IsArray(ZusKrit) Then
If CBool(ZusKrit) Then Set NoErrRange = tmpR(0)
Else: Set NoErrRange = tmpR(0)
End If
Set tmpR(0) = Nothing: Exit Function
End If
End With
hasCrits = 2 * CInt(nurVisZ) Xor CInt(IsArray(ZusKrit))
If CBool(hasCrits Mod 2) Then
If TypeName(ZusKrit) = "Range" Then
Set zK = ZusKrit: cct = zK.Columns.Count: rct = zK.Rows.Count: cif = 1: rif = 1
Else: On Error Resume Next
If IsError(LBound(ZusKrit, 2)) Then
If Bereich.Columns.Count = 1 Then _
ZusKrit = WorksheetFunction.Transpose(ZusKrit)
ElseIf Bereich.Rows.Count = 1 Then
ZusKrit = WorksheetFunction.Transpose(ZusKrit)
End If
If IsError(LBound(ZusKrit, 2)) Then
On Error GoTo ex: cif = LBound(ZusKrit)
cct = UBound(ZusKrit) + 1 - cif: rct = 1
Else: On Error GoTo ex
rif = LBound(ZusKrit, 1): rct = UBound(ZusKrit, 1) + 1 - rif
cif = LBound(ZusKrit, 2): cct = UBound(ZusKrit, 2) + 1 - cif
End If
End If
On Abs(Bereich.Columns.Count <> cct Or Bereich.Rows.Count <> rct) GoTo ex
Else: If Not CBool(ZusKrit) Then hasCrits = cxFalse
End If
For Each xZ In Bereich
If Not IsError(xZ) Then
Select Case hasCrits
Case cxCTrue
GoSub rt: GoSub vz
If Not (tmpR(1) Is Nothing Or tmpR(2) Is Nothing) Then Set tmpR(0) = tmpR(1)
Case cxFalse: Set tmpR(0) = xZ
Case cxTrue
rt:             If Not zK Is Nothing Then
If CBool(zK.Cells(rix + rif, cix + cif)) Then Set tmpR(1) = xZ
ElseIf rct = 1 Then
If CBool(ZusKrit(cix + cif)) Then Set tmpR(1) = xZ
ElseIf CBool(ZusKrit(rix + rif, cix + cif)) Then
Set tmpR(1) = xZ
End If
If hasCrits = cxCTrue Then Return Else Set tmpR(0) = tmpR(1)
Case cxAsUsed
vz:             If Not (xZ.EntireRow.Hidden Or _
xZ.EntireColumn.Hidden) Then Set tmpR(2) = xZ
If hasCrits = cxCTrue Then Return Else Set tmpR(0) = tmpR(2)
End Select
If Not tmpR(0) Is Nothing Then
If Not NoErrRange Is Nothing Then
Set NoErrRange = Union(NoErrRange, tmpR(0))
Else: Set NoErrRange = tmpR(0)
End If
End If
End If
If CBool(hasCrits Mod 2) Then _
cix = (cix + 1) Mod cct: rix = rix - CInt(cix = 0)
For tix = LBound(tmpR) To UBound(tmpR): Set tmpR(tix) = Nothing: Next tix
Next xZ
ex: Set zK = Nothing
End Function
Feedback nicht unerwünscht! Gruß, Luc :-?
Besser informiert mit …

Betrifft: @Luc:-?: bestimmt
von: Michael

Geschrieben am: 07.08.2016 17:50:41
Hi,
wir sollten uns evtl. angewöhnen, die Bearbeitung einer Frage "anzuzeigen", um annähernd zeitgleiche Beschäftigung mit dem Thema zu vermeiden.
Meine Lösung wirst Du vermutlich als "nur einmalig verwendbare, unnötige Arbeit" klassifizieren, wobei mich interessieren würde, wie lange Du für die Antwort benötigt hast: das "allerdings nicht in der benötigten Version" scheint mir darauf hinzudeuten, daß es auch mit Standard-UDFs nicht ohne "Denken bei der Arbeit" geht.
Sei's drum. Ich wollte nur mal hallo sagen, weil ich im Moment zu viel anderes zu tun habe als mich ums Forum zu kümmern.
Gute Zeit & schöne Grüße,
Michael

Betrifft: Danke, dito! Als ob ich's geahnt hätte, ...
von: Luc:-?

Geschrieben am: 07.08.2016 20:57:11
…Michael;
nach meiner AW ging mir der Vgl von Subroutinen und UDFs durch den Kopf und was für Xl typisch ist. Xl besteht aus beidem, uni­versalen Fktt, die in ZellFmln eingesetzt wdn, und Methoden, um ein Ergebnis zu erreichen, wozu auch Werkzeuge wie vorge­fer­tigte, komplette Analyse-Pgmm gehören. Dabei kommt es nicht so sehr auf die Art eines solchen Bausteins an, sondern vielmehr auf seine universelle Einsetzbarkeit.
Pgmmierer neigen dazu, komplette Projekte zu erstellen. Das ist für Profis das täglich Brot und unter diesem Aspekt OK. Univer­sa­listen (auch SystemPgmmierer) versuchen, von einer konkreten EinzelSituation zu abstrahieren, indem sie das Allgemeingültige herausarbeiten, und dann entweder einen neuen Baustein für ein vorhandenes System oder ein komplettes neues System von Bausteinen erzeugen. Letzteres haben die ursprünglichen Xl-Pgmmierer getan, Ersteres kam dann immer wieder mal dazu und dem versuche auch ich zu folgen.
Wenn dein Tool also so konstruiert ist, dass es ohne großen AnpassungsAufwand (auch von VBA-Laien) in analogen Situationen verwendet wdn kann, ist es ebenfalls keine InselLösung. Meine UDFs sind nur die „kleineren“ Bausteine, quasi ZiegelSteine, wäh­rend dein Pgm dann eine ganze Wand bilden würde.
Meine „ZiegelSteine“ verwende ich wieder und wieder und der ErstellungsAufwand einer darauf beruhenden Lösung entspricht idR dem einer klassischen Fml-Lösung (wenn ich mal den Aufwand für die UDF außer Betracht lasse). Das ist der Vorteil von (archivierten) Bausteinen… ;-)
Gruß, Luc :-?

Betrifft: AW: Danke, dito! Als ob ich's geahnt hätte, ...
von: Michael

Geschrieben am: 11.08.2016 14:29:40
Hi Luc:-?,
ob mein "Tool" vom (unbedarften) Anwender änderbar ist, wage ich zu bezweifeln...
Es macht mir halt (oft, aber mit abnehmender Tendenz) Spaß, schnell ein paar Zeilen mit Arrays zu formulieren. Wiederverwendbar wäre es für mich dann, wenn ich mir eine Datenbank basteln würde, mit der ich schnell auf solche Dinger zugreifen könnte. In meinem Herber-Ordner tummeln sich einige 100 Dateien, denen ich trotz einigermaßen sprechender Dateinamen nicht immer ansehe, welche zum aktuellen Problem paßt.
Ein paar verschachtelte Schleifen zu formulieren geht schneller als vorhandenen Code zu suchen: eindeutig ein Pluspunkt für Standard-UDFs.
Andererseits: letztere werden bei Dir und auch beim Hersteller immer umfangreicher (Aggregat), so daß ich (insbesondere) bei größeren Datenmengen lieber was "schnell formuliere" als eine Tabelle mit Formeln zu versehen.
Ich muß mich schon wieder aus dem Forum stehlen,
schöne Grüße,
Michael

Betrifft: Dito & schöWE! ;-) orT
von: Luc:-?
Geschrieben am: 12.08.2016 00:31:35
Nebenbei, Michael,
wirklich umfangreiche UDFs habe ich bisher nicht veröffentlicht. Die „ruhen“ in meinen AddIns (mehrere 100 bis 1000 PgmZeilen)…
Luc :-?

Betrifft: Dir auch und schöne Grüße owT
von: Michael
Geschrieben am: 12.08.2016 16:15:01

Betrifft: AW: Auflistung aus 0/1 Matrix
von: Michael

Geschrieben am: 07.08.2016 17:05:48
Hi Lukas,
im Blatt "GenData" änderst Du die Formeln so ab, daß nicht "1" übernommen wird, sondern der Wert (die ID) aus Spalte B; also z.B. in...
C2: =WENN('Plan erstellen'!B4=1;$B2;0)
bzw. in C27: =WENN('Plan erstellen'!B4=2;$B27;0)

usw.; die kannst Du dann je auf den Bereich C2:I26 bzw. C27:I51 kopieren (ich habe sie jetzt nur in C2 und C27 geändert).
Das Makro erstellt eine Kopie dieser Daten ab Spalte N und wirft alle "leeren Zeilen" raus:
Sub machen()
Dim z&, s&, basisNr&, z0
Dim arrB, arrW  ' array für Basis und Tabellen-WERTE
Const basis = "2,27,52,77,102,127"
' Das sind die Abschnitte mit Früh/Spät usw.
arrB = Split(basis, ",")
With Worksheets("Gendata")
arrW = .Range("A1").CurrentRegion
For basisNr = 0 To 4
For s = 3 To 9
z0 = arrB(basisNr) - 1
For z = z0 + 1 To arrB(basisNr + 1) - 1
If arrW(z, s) <> 0 Then
z0 = z0 + 1
arrW(z0, s) = arrW(z, s)
End If
Next
For z = z0 + 1 To arrB(basisNr + 1) - 1
arrW(z, s) = ""
Next
Next
Next
.Range("N1").Resize(UBound(arrW), UBound(arrW, 2)) = arrW
.Range("P1:V1") = ""
.Range("N1").CurrentRegion.RemoveDuplicates _
Columns:=Array(3, 4, 5, 6, 7, 8, 9), _
Header:=xlNo
.Columns("O:O").Delete Shift:=xlToLeft
.Range("C1:I1").Copy .Range("O1")
.Range("A1").Copy .Range("N1")
.Range("O1").Select
End With
Application.CutCopyMode = False
End Sub
Die Datei: https://www.herber.de/bbs/user/107455.xlsm
Schöne Grüße,
Michael

Betrifft: AW: Auflistung aus 0/1 Matrix
von: Daniel
Geschrieben am: 07.08.2016 17:57:57
Hi
das geht recht einfach mit einer kleinen Ergänzung und einer Matrixformel in der Auswertung.
https://www.herber.de/bbs/user/107457.xlsm
Gruß Daniel

Betrifft: Deine Zeile 2 ist verzichtbar, ...
von: Luc:-?
Geschrieben am: 07.08.2016 21:02:16
…Daniel,
wenn man Zeile 1 so aufbaut und dann pro Block in eine spezielle VerbundZelle wandelt.
Luc :-?

Betrifft: AW: Deine Zeile 2 ist verzichtbar, ...
von: Daniel

Geschrieben am: 07.08.2016 21:40:01
das mag durchaus sein Luc, aber bei Basiskenntnissen in Excel sollte man das ganze nicht noch komplizierter machen als notwendig.
Ausserdem geht es hier im Forum ja darum deutlich sichtbar darzustellen, wie das ganze gelöst wurde.
da ist dann deine spezielle Verbundzelle wahrscheinlich eher hinderlich und ich müsste sie zusätzlich erklären, damit jemand mit Basiskenntnissen in Excel die Datei versteht.
Gruß Daniel

Betrifft: Danke Michael, Luc:-? und Daniel
von: Lukas Pa

Geschrieben am: 07.08.2016 22:48:18
Vielen Dank für eure schnellen und ausführlichen Antworten/Lösungen!
Die Lösung von Luc mag zwar allgemeingültig sein, aber ich verstehe sie wirklich nur in Ansätzen und werde sie daher nicht verwenden können. Habe mir den Link gespeichert und werde mich zur gegebenen Zeit mit dem Thema UDF auseinandersetzen.
Die Lösungen von Daniel und Michael verstehe ich schon eher und ich habe mich heute Abend schon ein wenig mehr in die Matrixformeln eingearbeitet.
Wünsche einen guten Wochenstart
Lukas

Betrifft: Du hattest ein Makro verwendet, ...
von: Luc:-?
Geschrieben am: 08.08.2016 04:40:58
…Lukas,
weshalb ich annahm, du könntest auch mit einer UDF umgehen (deren Pgm ebenfalls in ein Modul gehört). Ansonsten sind UDFs genauso zu behandeln wie Xl-Fktt (wenn sie gut sind). Du musst ihr Pgm auch nicht unbedingt verstehen, sondern wie bei XlFktt nur ihre Wirkung… ;-)
Die UDF DataSet in der hier benötigten Version erscheint demnächst unter dem genannten Link.
Luc :-?

Excel-Beispiele zum Thema "Auflistung aus 0/1 Matrix"
Auflistung aller CommandBars Auflistung der Kalenderwochen eines variablen Jahres
Auflistung aller Kombinationsmöglichkeiten Auflistung der jeweils zuletzt ausgewählten 10 Zellen
Entfernungsmatrix listen Ausgabe einer benutzerdefinierten Funktion in Matrixformel
Werte aus Zellbereich in eine Matrix übernehmen und auslesen Portokosten aus einer Gewichts-/Gebietsmatrix errechnen
Matrix in UserForm-ListBox einlesen SVERWEIS-, WVERWEIS- und Matrixformel-Beispiele