Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1484to1488
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Hilfe bei VBA-Funktion "Verkettenwenn"

Hilfe bei VBA-Funktion "Verkettenwenn"
27.03.2016 19:01:13
Michi
Hallo liebes Forum,
ich benötige Hilfe bei der folgenden VBA-Funktion:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
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, Chr(10)) End Function Ich möchte gerne erreichen, dass wenn im Bereich_Verketten in einzelnen Zellen kein Wert enthalten ist, auch kein Zeilenumbruch hierfür eingefügt wird. Wie könnte man das einbauen?
Vielen Dank!!!

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hilfe bei VBA-Funktion "Verkettenwenn"
27.03.2016 19:27:35
ransi
Hallo Michi,
Mach ma so:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

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
            If Bereich_Verketten(L) <> "" Then mydic(L) = Bereich_Verketten(L)
        End If
    Next
    verkettenwenn = Join(mydic.items, Chr(10))
End Function


ransi

Anzeige
AW: Hilfe bei VBA-Funktion "Verkettenwenn"
28.03.2016 09:19:15
Michi
Hallo Ransi,
so etwas in der Art hatte ich auch schon probiert. Habe deinen Code mal eingefügt, aber die Zeilenumbrüche werden trotzdem noch eingefügt.
Hast du noch eine andere Idee? :))
Ich habe auch noch ein zweites Problem: Was mache ich, wenn ich mehrere Zellen von "Bereich_Kriterium" habe, quasi VERKETTENWENNS-Funktion? Gibt's da auch eine schicke Lösung?
Vielen Dank!!!

AW: Hilfe bei VBA-Funktion "Verkettenwenn"
28.03.2016 09:19:17
Michi
Hallo Ransi,
so etwas in der Art hatte ich auch schon probiert. Habe deinen Code mal eingefügt, aber die Zeilenumbrüche werden trotzdem noch eingefügt.
Hast du noch eine andere Idee? :))
Ich habe auch noch ein zweites Problem: Was mache ich, wenn ich mehrere Zellen von "Bereich_Kriterium" habe, quasi VERKETTENWENNS-Funktion? Gibt's da auch eine schicke Lösung?
Vielen Dank!!!

Anzeige
AW: Hilfe bei VBA-Funktion "Verkettenwenn"
28.03.2016 09:19:17
Michi
Hallo Ransi,
so etwas in der Art hatte ich auch schon probiert. Habe deinen Code mal eingefügt, aber die Zeilenumbrüche werden trotzdem noch eingefügt.
Hast du noch eine andere Idee? :))
Ich habe auch noch ein zweites Problem: Was mache ich, wenn ich mehrere Zellen von "Bereich_Kriterium" habe, quasi VERKETTENWENNS-Funktion? Gibt's da auch eine schicke Lösung?
Vielen Dank!!!

AW: Hilfe bei VBA-Funktion "Verkettenwenn"
28.03.2016 09:21:53
Michi
Hallo Ransi,
so etwas in der Art hatte ich auch schon probiert. Habe deinen Code mal eingefügt, aber die Zeilenumbrüche werden trotzdem noch eingefügt.
Hast du noch eine andere Idee? :))
Ich habe auch noch ein zweites Problem: Was mache ich, wenn ich mehrere Zellen von "Bereich_Kriterium" habe, quasi VERKETTENWENNS-Funktion? Gibt's da auch eine schicke Lösung?
Vielen Dank!!!

Anzeige
AW: Hilfe bei VBA-Funktion "Verkettenwenn"
28.03.2016 10:48:27
ransi
Hallo Michi,
"Habe deinen Code mal eingefügt, aber die Zeilenumbrüche werden trotzdem noch eingefügt."
Kann ich nicht nachvollziehen.
Tabelle1

 ABCD
11  0
21   
33C  
44D  
55E  
66F  
77G  
88H  
99I  
1010J  

Formeln der Tabelle
ZelleFormel
C1=verkettenwenn(A1:A10;1;B1:B10)
D1=LÄNGE(C1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Prüf mal bei dir ob Bereich_Verketten(L) ein Leerzeichen oder Ähnliches drinsteht.
Hast du noch eine andere Idee? :))
PRobier mal dies:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

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
            If Len(Bereich_Verketten(L)) <> 0 Then mydic(L) = Bereich_Verketten(L)
        End If
    Next
    verkettenwenn = Join(mydic.items, Chr(10))
End Function


zu Verkettenwenns() lass ich mir was einfallen...
ransi

Anzeige
Was ist dein Primärziel, ...
28.03.2016 15:46:27
Luc:-?
…Michi,
Pgmmieren einer eigenen Fkt oder Lösung der Aufgabe dieser Fkt?
Im letzteren Fall kannst du einfach bereits Vorhandenes in einer 1zelligen (singularen) MatrixFml nutzen (BspBezug s.unten):
{=VJoin(WENN((A1:A10=1)*(B1:B10"");B1:B10;"");ZEICHEN(10);-1)}
{=VJoin(WENN((B1:B10"")*((A1:A108));B1:B10;"");ZEICHEN(10);-1)}
Letztveröffentlichte VJoin-Version 1.4 (nur in hochgeladenen BspMappen!).
Im ersteren Fall kannst du auf Ransis Einfall warten oder den sinnvoll allgemeinen Ansatz der Argument­Deklaration deiner Fkt sich auch im PgmVerlauf widerspiegeln lassen, indem du dir etwas mehr Arbeit mit dem Differenzieren der jeweiligen ArgumentAngabe machst, zB so:
Rem Fkt nur für Vektoren (Zeilen oder Spalten von Bereichen bzw Datenfeldern)
Public Function VerkettenWenn(Bereich_Kriterium, Kriterium, Bereich_Verketten)
Dim isRow As VbTriState, L As Long, U As Long, myDic As Object
On Error GoTo fx: Set myDic = CreateObject("Scripting.Dictionary")
If TypeName(Bereich_Kriterium) = "Range" Then
If Bereich_Kriterium.Columns.Count > 1 And Bereich_Kriterium.Rows.Count > 1 Then _
Err.Raise xlErrRef
isRow = vbUseDefault: L = 1: U = Bereich_Kriterium.Count
ElseIf IsArray(Bereich_Kriterium) Then
On Error Resume Next
If IsError(LBound(Bereich_Kriterium, 2)) Then
isRow = vbUseDefault: L = LBound(Bereich_Kriterium): U = UBound(Bereich_Kriterium)
ElseIf UBound(Bereich_Kriterium, 1) > UBound(Bereich_Kriterium, 2) Then
If UBound(Bereich_Kriterium, 2) > LBound(Bereich_Kriterium, 2) Then _
On Error GoTo fx: Err.Raise xlErrRef
L = LBound(Bereich_Kriterium, 1): U = UBound(Bereich_Kriterium, 1)
ElseIf UBound(Bereich_Kriterium, 1) > LBound(Bereich_Kriterium, 1) Then
On Error GoTo fx: Err.Raise xlErrRef
Else: isRow = vbTrue
L = LBound(Bereich_Kriterium, 2): U = UBound(Bereich_Kriterium, 2)
End If
On Error GoTo fx
Else: L = 1: U = 1
End If
For L = L To U
If isRow = vbUseDefault Then
If Bereich_Kriterium(L) = Kriterium Then
If Len(Bereich_Verketten(L))  0 Then myDic(L) = Bereich_Verketten(L)
End If
ElseIf isRow = vbTrue Then
If Bereich_Kriterium(1, L) = Kriterium Then
If Len(Bereich_Verketten(1, L))  0 Then myDic(L) = Bereich_Verketten(1, L)
End If
ElseIf Bereich_Kriterium(L, 1) = Kriterium Then
If Len(Bereich_Verketten(L, 1))  0 Then myDic(L) = Bereich_Verketten(L, 1)
End If
Next L
If CBool(Err.Number) Then
fx:     VerkettenWenn = CVErr(Err.Number)
Else: VerkettenWenn = Join(myDic.items, Chr(10))
End If
Set myDic = Nothing
End Function
Allerdings müsste auch Arg3 der Fkt Bereich_Verketten auf gleiche Weise wie Arg1 untersucht wdn (bisher fktt das nur für ZellBereiche - 1 Spalte oder 1 Zeile), um in anderem Fall, Datenfeld aus Berechnung als Arg3, keine böse Überraschung zu erleben. Das wäre dann deine Aufgabe. In der Zelle sieht's als 1zellige (Matrix-)Fml dann so aus:
=VerkettenWenn(A1:A10;1;B1:B10) für Ransis Bsp (alles mit Ransis BspDaten)
{=VerkettenWenn((A1:A108);1;B1:B10)} für deinen ZusatzWunsch
Das kannst du dir im anderen Fall alles sparen, aber was dir letztlich besser geeignet erscheint, musst du selbst wissen. Allerdings verkettet VJoin in den obigen Fmln nur ungleiche Werte. Falls alle Werte außer leere verkettet wdn sollen, wird die Fml etwas komplizierter.
Feedback nicht unerwünscht! Gruß, Luc :-?
Besser informiert mit …

Anzeige
Keine AW ist auch 'ne AW... :-[ owT
30.03.2016 16:31:50
Luc:-?
:-?

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige