Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Funktion verketten wenn, mehrfache Werte nur einma

Funktion verketten wenn, mehrfache Werte nur einma
Judith
Hallo,
ich habe eine Funktion gegooglet, die mir sehr hilfreich ist.
Es geht darum, Zeichenfolgen zu verketten wenn eine Bedingung erfüllt ist.
  • Public Function VerkettenWenn(Bereich_Kriterium, Kriterium, Bereich_Verketten)
    Dim mydic As Object
    Dim L As Long
    Set mydic = CreateObject("Scripting.Dictionary")
    For L = 1 To Bereich_Kriterium.Count
    If Bereich_Kriterium(L) = Kriterium Then
    mydic(L) = Bereich_Verketten(L)
    End If
    Next
    VerkettenWenn = Join(mydic.items, ", ")
    End Function
    


  • Da Problem ist, die Funktion verkettet auch mehrfach vorkommende, gleiche Werte. Wenn also der Wert "Apfel" mehrfach vorkommt, wir er auch mehrfach verkettet. Ich kann den Wert aber nur 1x brauchen.
    Meine Versuche waren zwecklos, dafür reicht es einfach nicht.
    Kann mir jemand helfen?
    Vielen Dank an Euch alle!
    Gruß
    Vorher noch auf BereitsVorhanden überprüfen, ...
    13.08.2012 17:20:54
    Luc:-?
    …Judith…
    Function ConcateFirstIf(Bereich_Kriterium, Kriterium, Bereich_Verketten)
    Dim mydic As Object, L As Long, isExist As Boolean
    On Error Resume Next
    Set mydic = CreateObject("Scripting.Dictionary")
    For L = 1 To Bereich_Kriterium.Count
    If Bereich_Kriterium(L) = Kriterium Then
    isExist = CBool(WorksheetFunction.Match(Bereich_Verketten(L), mydic.items, 0))
    If Not isExist Then mydic(L) = Bereich_Verketten(L)
    End If
    Next L
    ConcateFirstIf = Join(mydic.items, ", ")
    End Function *
    
    * ungetestet!
    Gruß Luc :-?
    AW: Vorher noch auf BereitsVorhanden überprüfen, ...
    13.08.2012 17:57:24
    Ramses
    Hallo
    Mich irritiert die Frage grundsätzlich.
    Im Dictionary sind doch eigentlich gar keine dopppelten Einträge möglich, die werden doch das vorhandene Dictionary-Item einfach überschrieben.
    Oder trügt mich hier meine Erinnerung ?
    Gruss Rainer
    Anzeige
    K.A., aber wenn's so ist, läuft hier was ...
    13.08.2012 18:07:32
    Luc:-?
    …falsch, Rainer,
    aber logisch wär's schon bei einem Wörterbuch!
    Möglicherweise sehen ihre Begriffe nur gleich aus, sind's aber nicht! Mal noch Trim o.ä. einbauen!
    Gruß Luc :-?
    AW: K.A., aber wenn's so ist, läuft hier was ...
    13.08.2012 19:56:45
    Judith
    Hallo,
    vielen Dank an alle für Eure Unterstützung und dass Ihr mit mir Eure Gedanken teilt. Ich sehe mir das morgen früh mal an. Bestimmt bin ich dann schon weiter. Also, danke, und einen schönen Abend noch!
    Gruß
    AW: Funktion verketten wenn, mehrfache Werte nur einma
    13.08.2012 18:28:43
    Josef

    Hallo Judith,
    Public Function VERKETTENWENN(Bereich_Kriterium As Variant, Kriterium As Variant, Bereich_Verketten As Variant, Optional Trennzeichen As String = ", ", Optional Doppelte As Boolean = False, Optional Sortiert As Boolean = True) As Variant
      Dim objArrayList As Object, Field1 As Variant, Field2 As Variant
      Dim lngR As Long, lngC As Long
      
      On Error GoTo ErrExit
      
      Field1 = Bereich_Kriterium
      Field2 = Bereich_Verketten
      
      If UBound(Field1, 1) <> UBound(Field2, 1) Or UBound(Field1, 2) <> UBound(Field2, 2) Then
        VERKETTENWENN = CVErr(xlErrRef)
        Exit Function
      End If
      
      Set objArrayList = CreateObject("System.Collections.Arraylist")
      
      With objArrayList
        For lngR = LBound(Field1, 1) To UBound(Field1, 1)
          For lngC = LBound(Field1, 2) To UBound(Field1, 2)
            If Field1(lngR, lngC) = Kriterium Then
              If Not .Contains(Trim(Field2(lngR, lngC))) Or Doppelte Then
                If Trim(Field2(lngR, lngC)) <> "" Then .Add Trim(Field2(lngR, lngC))
              End If
            End If
          Next
        Next
        If Sortiert Then .Sort
        VERKETTENWENN = Join(.toArray, Trennzeichen)
      End With
      
      Exit Function
      ErrExit:
      VERKETTENWENN = CVErr(xlErrValue)
    End Function



    « Gruß Sepp »

    Anzeige
    AW: Funktion verketten wenn, mehrfache Werte nur einma
    14.08.2012 07:48:43
    Judith
    Hallo Sepp,
    ich bin baff, kein Wunder, dass meine Versuche ins Nirwana gelaufen sind.
    Alles, was ich bis jetzt mit der Funktion gemacht habe, funktioniert tadellos. Mal sehen, was sie noch alles kann. Vielleicht kann sie auch Essen kochen;-)
    Sicher hilft der Code auch anderen...ganz ehrlich, ich komme aus dem Staunen nicht mehr raus.
    Viele Grüße
    AW: Funktion verketten wenn, mehrfache Werte nur einma
    14.08.2012 07:04:46
    Judith
    Guten Morgen,
    Eure Beiträge haben mit eine ganz Menge gebracht, ich muss das Ganze erst noch mal überdenken. Wahrscheinlich war ich auf dem Holzweg mit meiner Denkweise, kein Wunder, dass Euch meine Frage irritiert hat.
    Also, danke noch mal und einen schönen Tag!
    Gruß
    Anzeige

    317 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige