Microsoft Excel

Excel und VBA: Beitrag aus Herbers Excel-Forumsarchiv

Zählennwenn mit Zahlenkombinationen

Betrifft: Zählennwenn mit Zahlenkombinationen
von: Josef
Geschrieben am: 13.02.2006 16:17:56

Guten Tag zusammen,

habe in Tabelle1, drei bedingte Formatierungen eingestellt um folgendes zu erreichen: 1. Doppelte markieren, 2. Wenn Zelle leer dann grau unterlegen und 3. Wenn eine Zahl drin steht, weiß lassen. Funktioniert alles bei einzelnen Zahlen, sobald ich aber eine Kombination von Zahlen eingebe, z.B. 22+23+25 in einer Zelle, arbeitet die Bedingung natürlich nicht mehr.

Kann mir bitte jemand bei dieser Lösung helfen?

Danke schon mal im voraus

Gruss Josef
  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: Josef Ehrensberger
Geschrieben am: 13.02.2006 16:36:04

Hallo Josef!

Welche Formeln verwendest du?
Was funktioniert nicht?

Vielleicht kannst du ein Beispiel hochladen!


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************



  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: Josef
Geschrieben am: 13.02.2006 16:48:46

Hallo Sepp!

Habe mal ein Muster hochgeladen.

Sepp, ich möchte erreichen, das keine der Zahlen doppelt eingetragen werden kann. Egal ob als einzelne Ganzahl oder als Kombination vo mehreren Ganzzahlen. Alle Zahlen zwischen 1 und 100 nur einmal!

http://www.herber.de/bbs/user/31008.xls

Danke schon mal

Gruss
Josef


  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: Josef Ehrensberger
Geschrieben am: 13.02.2006 17:05:01

Hallo Josef!

Dazu fällt mir nur eine Lösung mit einem Definierten Namen und Hilfsspalten ein!

http://www.herber.de/bbs/user/31011.xls


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************



  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: Josef
Geschrieben am: 13.02.2006 17:58:57

Hallo Sepp!

Funktioniert leider nicht so wie es gemeint habe. Danke aber für Deine Mühe.

Es sollte keine! der in Tabelle1 eingebenen Zahlen zweimal erscheinen. Egal ob als einzelne Zahl oder als Kombination. Bei Eingabe von 10+20+30 in einer Zelle, sollte anschliessend die 10 oder 20 oder 30 auch als einzelne Zahl abgewiesen werden.

Gruss Josef


  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: Luc:-?
Geschrieben am: 15.02.2006 12:40:16

Hallo Josef,
habe mal meine xxlFunktionskiste durchgesehen, ob sich etwas findet, was eine Lösung deines Problems ermöglicht. Das Ergebnis siehst du im Folgenden:

Leider nutzt dir das so nicht viel, da konventionelle Lösungen nur unbefriedigende Ergebnisse gebracht haben. Bei Interesse deinerseits könnte ich aber eine (abgespeckte) Funktionsvariante oder Speziallösung ins Forum stellen.
Gruß Luc :-?
PS: Besten Dank für das schöne Anwendungsbeispiel für meine udFs!


  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: Josef
Geschrieben am: 17.02.2006 00:03:25

Hallo Luc:-?,

entschuldige bitte das ich mich jetzt erst melde, aber ich war drei Tage nicht in
in meinem Büro.

Als ich Deine Lösung gesehen habe, bin ich fast vom Drehstuhl gefallen. Ich glaube, Du hast genau verstanden, was ich gemeint habe. Dein Angebot, eine Speziallösung ins Forum zu stellen, würde ich natürlich sehr begrüssen.

Vielen Dank für Deine Mühe.

Gruss Josef


  


Betrifft: AW: Zahlenkombinationen
von: Luc:-?
Geschrieben am: 17.02.2006 02:08:10

Hallo Josef,
Danke für die Rückmeldung! Hast offensichtlich einen standfesten Stuhl! ;)
Muss mal sehen, wann das klappt. Hoffe, du hast es nicht zu eilig. Wenn ich das nicht mehr in diesen Thread (wenn im Archiv) trotz gemerkter Adresse reinkriege, musst du mal im Forum nach Luc: suchen (falls du nicht auch schon mit Michas Variante zufrieden bist, wenn die Unstimmigkeit beseitigt ist - das dann bitte mitteilen!).
Gruß Luc :-?


  


Betrifft: AW: Zahlenkombinationen
von: Josef
Geschrieben am: 17.02.2006 19:53:01

Hallo Luc!

Habe Michas Skript mal in das Original installiert und getestet. Mir ist nach Eingabe von Zahlen -egal ob Ganzzahl oder Zahlenkombination, ausser in den Spalten C und D, alle anderen Eingaben sofort rot unterlegt werden. Ich muss aber die Eingaben frei eingeben können-z.B. in C6 dann in E12 usw. Es bleiben auch Zelle leer, die dann grau unterlegt sein müssen. Luc, kannst Du mir bitte deine Version mal ins Forum stellen?

Danke schon mal im Voraus

Gruss Josef


  


Betrifft: AW: Zahlenkombinationen
von: Luc:-?
Geschrieben am: 18.02.2006 17:01:01

Hallo Josef,
leider musst du jetzt ins Archiv schauen, denke aber, wirst das schon finden. Habe weitergekramt und noch 'ne andere udF gefunden. Die in Kombination mit 2 anderen udFs liefert für mein Testbsp das gleiche Ergebnis wie du hier sehen kannst:

Die 3 udFs folgen hier, damit du sie kopieren kannst. Die beste Methode zu ihrer universalen Anwendung wäre es, eine leere Mappe mit 1 Blatt anzulegen, der einen aussagekräftigen Namen zu geben, im Makroeditor diesem "Projekt" ein Modul hinzuzufügen und die 3 Funktionen hineinzukopieren. Anschließend in den Eigenschaften des Projekts "AddIn" auf "True" setzen und das Ganze in den Ordner ...Office\Makro speichern (Macros ist für Word!).
Dann nicht vergessen in deiner anwendenden Mappe den Namen WVgl zu definieren, in dessen Formelteil die blaue Formel lt Abbild steht (ab "="). WVgl wird somit zur benannten Formel. Das ist wichtig, weil sonst die bedingte Formatierung nicht funktioniert (arbeitet nicht mit Externbezügen)! Dabei sollte die 1.Zelle, von der aus du auch die bedingte Formatierung über die Tabelle ausdehnst, markiert sein (sonst stimmen Bezüge nicht). Falls du deine Leerzeilen beibehalten willst, musst du das Ganze entsprechend anpassen.
Rem Anzahl des Auftretens einer Zeichenfolge in einer anderen
'   Autor: Luc  -   1.Publ: www.herber.de   -   20061218
Function CountOn(ByVal ZFolge As String, _
                 ByVal ZKomb As String) As Integer
    Dim i As Integer, k As Integer
    k = Len(ZKomb)
    If Len(ZFolge) < k Then Exit Function
    For i = 1 To Len(ZFolge)
        If Mid(ZFolge, i, k) = ZKomb Then
            CountOn = CountOn + 1
            i = i + k - 1
        End If
    Next i
End Function
Rem Schnittmenge 2er Listen als Text (ErgebnisLi enthält nur Elemente, die in bd Li auftret)
'   Autor: Luc  -   1.Publ: www.herber.de   -   20061218
Function SMenge(ByVal M1 As String, ByVal M2 As String, _
                Optional TrennZ As Variant) As String
    Dim i As Long, j As Long, k As Long, l As Long, _
        ltz As Integer, m() As Integer, n() As Integer, tm As Variant
    On Error Resume Next
    If IsMissing(TrennZ) Then
        TrennZ = " "
    End If
    ltz = Len(TrennZ)
    i = Len(M1): j = Len(M2)
    ReDim m(i) As Integer, n(j) As Integer
    m(0) = 1 - ltz
    n(0) = 1 - ltz
    M1 = M1 & TrennZ
    For i = 1 To Len(M1)
        If Mid(M1, i, ltz) = TrennZ Then
            k = k + 1: m(k) = i
        End If
    Next i
    M2 = M2 & TrennZ
    For i = 1 To Len(M2)
        If Mid(M2, i, ltz) = TrennZ Then
            l = l + 1: n(l) = i
        End If
    Next i
    For i = 1 To k
        tm = Mid(M1, m(i - 1) + ltz, m(i) - m(i - 1) - ltz)
        For j = 1 To l
            If tm = Mid(M2, n(j - 1) + ltz, n(j) - n(j - 1) - ltz) Then
                SMenge = SMenge & TrennZ & tm
                Exit For
            End If
        Next j
    Next i
    If SMenge = "" Then Exit Function
    SMenge = Mid(SMenge, ltz + 1)
End Function
Rem vereinigt (unterschiedliche) (Teil-)Inhalte der Zellen von Bereich zu einem String
'   Autor: Luc  -   1.Publ: www.herber.de   -   20061218
Function ChainOn(ByVal Bereich As Variant, Optional ByVal BindeZ As Variant, _
                 Optional ByVal nurUngleiche As Variant, _
                 Optional ByVal inLänge_bisPos_vorZ As Variant, _
                 Optional ByVal abPos_nachZ As Variant) As Variant
    Dim i As Integer, z As Boolean, y As String, yk As String, x As Object
    If Not IsObject(Bereich) Then
        ChainOn = ""
        Exit Function
    End If
    If IsMissing(BindeZ) Then
        BindeZ = ""
    End If
    If IsMissing(nurUngleiche) Then
        nurUngleiche = False
    Else: nurUngleiche = CBool(nurUngleiche)
    End If
    For Each x In Bereich
        If IsMissing(inLänge_bisPos_vorZ) And IsMissing(abPos_nachZ) Then
            If x.NumberFormat <> "General" Then
                y = Trim(WorksheetFunction.Text(x.Value, x.NumberFormatLocal))
            Else: y = x.Value
            End If
        Else
            If IsNumeric(x.Value) Then
                y = Trim(x.Value)
            Else: y = x.Value
            End If
            y = PartOf(y, abPos_nachZ, inLänge_bisPos_vorZ)
            If BindeZ <> "" And Len(y) > 0 Then
                While Left(y, Len(BindeZ)) = BindeZ
                    y = Right(y, Len(y) - Len(BindeZ))
                Wend
                While Right(y, Len(BindeZ)) = BindeZ
                    y = Left(y, Len(y) - Len(BindeZ))
                Wend
            End If
        End If
        If y <> "" Then
            If nurUngleiche And InStr(ChainOn, y) > 0 Then GoSub nu         
            ChainOn = dIf(ChainOn = "", y, dIf(nurUngleiche And y = "", _
                      ChainOn, ChainOn & BindeZ & y))                       
        End If
    Next x
    If ChainOn = BindeZ Or ChainOn = "" Then
        ChainOn = ""
    ElseIf Right(ChainOn, 1) = BindeZ Then
        ChainOn = Left(ChainOn, Len(ChainOn) - 1)
    Else: ChainOn = Trim(ChainOn)
    End If
    Exit Function
nu: If IsMissing(BindeZ) Then Return
    If InStr(ChainOn, BindeZ) > 0 Or y = ChainOn Then           'Entfernen v.MehrfachKompp
        i = 1
        While i <= Len(y)
            yk = PartOf(Mid(y, i) & BindeZ, 1, BindeZ)
            If ListOp(y, "ceq", yk, BindeZ) > 1 Then            'Prüfung innerhalb von y
                y = Left(y, i - 1) & Mid(y, i + _
                    Len(yk) + Len(BindeZ))
            ElseIf ChainOn <> "" Then       'Vgl der y-Kompp m.schon exist ChainOn-Wert
                If ListOp(ChainOn, "ceq", yk, BindeZ) > 0 Then
                    y = Left(y, i - 1) & Mid(y, i + _
                        Len(yk) + Len(BindeZ))
                Else
                    i = i + Len(yk) + Len(BindeZ)
                End If
            Else
                i = i + Len(yk) + Len(BindeZ)
            End If
        Wend
    End If
    Return
co: y = Left(y, i - 1) & Mid(y, i + Len(yk) + Len(BindeZ))
    Return
End Function 

Viel Spaß und schönes WE
Luc :-?


  


Betrifft: AW: Zahlenkombinationen
von: Luc:-?
Geschrieben am: 18.02.2006 17:01:52

Hallo Josef,
leider musst du jetzt ins Archiv schauen, denke aber, wirst das schon finden. Habe weitergekramt und noch 'ne andere udF gefunden. Die in Kombination mit 2 anderen udFs liefert für mein Testbsp das gleiche Ergebnis wie du hier sehen kannst:

Die 3 udFs folgen hier, damit du sie kopieren kannst. Die beste Methode zu ihrer universalen Anwendung wäre es, eine leere Mappe mit 1 Blatt anzulegen, der einen aussagekräftigen Namen zu geben, im Makroeditor diesem "Projekt" ein Modul hinzuzufügen und die 3 Funktionen hineinzukopieren. Anschließend in den Eigenschaften des Projekts "AddIn" auf "True" setzen und das Ganze in den Ordner ...Office\Makro speichern (Macros ist für Word!).
Dann nicht vergessen in deiner anwendenden Mappe den Namen WVgl zu definieren, in dessen Formelteil die blaue Formel lt Abbild steht (ab "="). WVgl wird somit zur benannten Formel. Das ist wichtig, weil sonst die bedingte Formatierung nicht funktioniert (arbeitet nicht mit Externbezügen)! Dabei sollte die 1.Zelle, von der aus du auch die bedingte Formatierung über die Tabelle ausdehnst, markiert sein (sonst stimmen Bezüge nicht). Falls du deine Leerzeilen beibehalten willst, musst du das Ganze entsprechend anpassen.
Rem Anzahl des Auftretens einer Zeichenfolge in einer anderen
'   Autor: Luc  -   1.Publ: www.herber.de   -   20061218
Function CountOn(ByVal ZFolge As String, _
                 ByVal ZKomb As String) As Integer
    Dim i As Integer, k As Integer
    k = Len(ZKomb)
    If Len(ZFolge) < k Then Exit Function
    For i = 1 To Len(ZFolge)
        If Mid(ZFolge, i, k) = ZKomb Then
            CountOn = CountOn + 1
            i = i + k - 1
        End If
    Next i
End Function
Rem Schnittmenge 2er Listen als Text (ErgebnisLi enthält nur Elemente, die in bd Li auftret)
'   Autor: Luc  -   1.Publ: www.herber.de   -   20061218
Function SMenge(ByVal M1 As String, ByVal M2 As String, _
                Optional TrennZ As Variant) As String
    Dim i As Long, j As Long, k As Long, l As Long, _
        ltz As Integer, m() As Integer, n() As Integer, tm As Variant
    On Error Resume Next
    If IsMissing(TrennZ) Then
        TrennZ = " "
    End If
    ltz = Len(TrennZ)
    i = Len(M1): j = Len(M2)
    ReDim m(i) As Integer, n(j) As Integer
    m(0) = 1 - ltz
    n(0) = 1 - ltz
    M1 = M1 & TrennZ
    For i = 1 To Len(M1)
        If Mid(M1, i, ltz) = TrennZ Then
            k = k + 1: m(k) = i
        End If
    Next i
    M2 = M2 & TrennZ
    For i = 1 To Len(M2)
        If Mid(M2, i, ltz) = TrennZ Then
            l = l + 1: n(l) = i
        End If
    Next i
    For i = 1 To k
        tm = Mid(M1, m(i - 1) + ltz, m(i) - m(i - 1) - ltz)
        For j = 1 To l
            If tm = Mid(M2, n(j - 1) + ltz, n(j) - n(j - 1) - ltz) Then
                SMenge = SMenge & TrennZ & tm
                Exit For
            End If
        Next j
    Next i
    If SMenge = "" Then Exit Function
    SMenge = Mid(SMenge, ltz + 1)
End Function
Rem vereinigt (unterschiedliche) (Teil-)Inhalte der Zellen von Bereich zu einem String
'   Autor: Luc  -   1.Publ: www.herber.de   -   20061218
Function ChainOn(ByVal Bereich As Variant, Optional ByVal BindeZ As Variant, _
                 Optional ByVal nurUngleiche As Variant, _
                 Optional ByVal inLänge_bisPos_vorZ As Variant, _
                 Optional ByVal abPos_nachZ As Variant) As Variant
    Dim i As Integer, z As Boolean, y As String, yk As String, x As Object
    If Not IsObject(Bereich) Then
        ChainOn = ""
        Exit Function
    End If
    If IsMissing(BindeZ) Then
        BindeZ = ""
    End If
    If IsMissing(nurUngleiche) Then
        nurUngleiche = False
    Else: nurUngleiche = CBool(nurUngleiche)
    End If
    For Each x In Bereich
        If IsMissing(inLänge_bisPos_vorZ) And IsMissing(abPos_nachZ) Then
            If x.NumberFormat <> "General" Then
                y = Trim(WorksheetFunction.Text(x.Value, x.NumberFormatLocal))
            Else: y = x.Value
            End If
        Else
            If IsNumeric(x.Value) Then
                y = Trim(x.Value)
            Else: y = x.Value
            End If
            y = PartOf(y, abPos_nachZ, inLänge_bisPos_vorZ)
            If BindeZ <> "" And Len(y) > 0 Then
                While Left(y, Len(BindeZ)) = BindeZ
                    y = Right(y, Len(y) - Len(BindeZ))
                Wend
                While Right(y, Len(BindeZ)) = BindeZ
                    y = Left(y, Len(y) - Len(BindeZ))
                Wend
            End If
        End If
        If y <> "" Then
            If nurUngleiche And InStr(ChainOn, y) > 0 Then GoSub nu         
            ChainOn = dIf(ChainOn = "", y, dIf(nurUngleiche And y = "", _
                      ChainOn, ChainOn & BindeZ & y))                       
        End If
    Next x
    If ChainOn = BindeZ Or ChainOn = "" Then
        ChainOn = ""
    ElseIf Right(ChainOn, 1) = BindeZ Then
        ChainOn = Left(ChainOn, Len(ChainOn) - 1)
    Else: ChainOn = Trim(ChainOn)
    End If
    Exit Function
nu: If IsMissing(BindeZ) Then Return
    If InStr(ChainOn, BindeZ) > 0 Or y = ChainOn Then           'Entfernen v.MehrfachKompp
        i = 1
        While i <= Len(y)
            yk = PartOf(Mid(y, i) & BindeZ, 1, BindeZ)
            If ListOp(y, "ceq", yk, BindeZ) > 1 Then            'Prüfung innerhalb von y
                y = Left(y, i - 1) & Mid(y, i + _
                    Len(yk) + Len(BindeZ))
            ElseIf ChainOn <> "" Then       'Vgl der y-Kompp m.schon exist ChainOn-Wert
                If ListOp(ChainOn, "ceq", yk, BindeZ) > 0 Then
                    y = Left(y, i - 1) & Mid(y, i + _
                        Len(yk) + Len(BindeZ))
                Else
                    i = i + Len(yk) + Len(BindeZ)
                End If
            Else
                i = i + Len(yk) + Len(BindeZ)
            End If
        Wend
    End If
    Return
co: y = Left(y, i - 1) & Mid(y, i + Len(yk) + Len(BindeZ))
    Return
End Function 

Viel Spaß und schönes WE
Luc :-?


  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: MichaV
Geschrieben am: 16.02.2006 00:35:02

Hallo Josef,

nette Aufgabenstellung. Guck mal, ob es so okay ist:
http://www.herber.de/bbs/user/31081.xls

Hinweis: Spalten K-X ausgeblendet, für jede Spalte ist ein Zahlenwert vorgesehen. Du kannst in jeder Zeile der Tabelle somit 14 verschiedene Zahlen eintragen. Wenn es mehr sein sollen, mußt Du die Hilfstabelle nach rechts erweitern. Du musst dafür nur die Formeln weiterziehen und den Namen "Daten" neu anpassen.

Gruß- Micha

PS: Rückmeldung wäre nett.
PPS: @Luc, danke für die Mail. Hab großartige Neuigkeiten für Dich!
PPPS: @Sepp, hoffe Du bist mir nicht böse wegen meinem Privatforum- Beitrag.


  


Betrifft: @Micha: Zählennwenn mit Zahlenkombinationen
von: Luc:-?
Geschrieben am: 16.02.2006 18:50:01

Hallo Micha,
da machst du mich ja richtig neugierig! Bin gespannt...
Ansonsten: In deinem klassischen Lösungsansatz, der für mich als Pendant zu meiner udF-Lösung interessant ist, scheint sich noch ein Fehler zu verstecken. Hier zum Vgl mal meine Testdaten mit meiner udF-Lösung (exakteste Variante, leider auch superlanger Code, weil Universal-Fkt für viele Zwecke nebst interner Verwendung weiterer udF - also hier nicht anbietbar!):

Gruß Luc :-?


  


Betrifft: AW: @Micha: Zählennwenn mit Zahlenkombinationen
von: MichaV
Geschrieben am: 16.02.2006 19:19:20

Hallo Luc,

wäre ja nun noch schön wenn Du mir sagen würdest, welches Verhalten auf einen Fehler schließen lässt.

Gruß- Micha

PS: Rückmeldung wäre nett.


  


Betrifft: AW: @Micha: Fehler, weil...
von: Luc:-?
Geschrieben am: 17.02.2006 02:00:27

...deine Lösung mit meinen Testdaten nicht zum gleichen Ergebnis führt wie meine Lösung, die logisch/manuell nachvollziehbar ist. Dachte, du würdest das selbst testen wollen. Aber bitte, vergleiche selbst:

Gruß Luc :-?


  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: Josef
Geschrieben am: 17.02.2006 14:30:15

Hallo Micha!

Sorry, dass ich mich so spät erst melde, aber ich war 3 Tage nicht im Büro. (Grippe)

Vielen Dank, für die wohl sehr umfangreiche Lösung!

Habe Deine Lösung mal durchgetestet und nur einen Fehler bei der BEDINGTEN FORMATIERUNG
feststellen können. Der Fehler stellt sich so dar: Wenn noch in keiner Zelle eine Zahl steht und gebe dann z.B. in H5 eine Zahl ein, wird die Zelle sofort rot unterlegt. Ich vermute mal, dass die Formatierung von mir falsch ausgeführt wurde. Frage dazu:- wird die B.Formatierung, Spalten oder Zeilenweise kopiert?-oder wie?

Nochmals Danke

Gruss Josef


  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: MichaV
Geschrieben am: 17.02.2006 21:26:55

Hallo Josef,

Du schrobst: Sepp, ich möchte erreichen, das keine der Zahlen doppelt eingetragen werden kann

Damit ist Deine Rot- Formatierung zur Kennzeichnung von Doppelten doch nicht mehr notwendig und Du kannst sie löschen.

Oder hab ich mal wieder was nicht mitgeriegt?

Gruß- Micha

PS: Rückmeldung wäre nett.


  


Betrifft: AW: Zählennwenn mit Zahlenkombinationen
von: Josef
Geschrieben am: 18.02.2006 00:51:47

Hallo Micha!

Musste erst mal die Original-Mappe vorbereiten und ein paar Makros verändern. Jetzt läuft aber erst mal alles Super.

Vielen Dank für deine Mühe und Arbeit!

Gruss Josef