Microsoft Excel

Herbers Excel/VBA-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": http://www.herber.de/bbs/user/107450.xlsm

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?

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: http://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.
http://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 :-?