Anzeige
Archiv - Navigation
1320to1324
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

VBA: besondere Auflistung

VBA: besondere Auflistung
12.07.2013 18:47:30
WalterK
Hallo,
ich suche eine Lösung mit VBA!
Dieses Mal habe ich die Beschreibung nur in der hochgeladenen Datei angeführt, weil mir die Erläuterung ohne konkretes Beispiel nur sehr schwer möglich gewesen wäre.
https://www.herber.de/bbs/user/86332.xls
Danke und Servus, Walter

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: besondere Auflistung
13.07.2013 06:40:51
Mustafa
Hallo Walter,
hier mal eine Formellösung :
Für die Zelle Q5 nach rechts und unten weiterziehen :
=INDEX(INDIREKT("$D$"&KKLEINSTE(WENN($C$5:$C$10=$Q5;ZEILE(5:10));1) &":$D$"&KGRÖSSTE(WENN($C$5:$C$10=$Q5;ZEILE(5:10));1)):$O$10;VERGLEICH("*";D$5:D$10;0);SPALTE(A1))
Rückmeldung obs Hilft wäre nett.
Gruß aus der Domstadt Köln.

Noch nicht ganz ...
13.07.2013 09:24:05
WalterK
Hallo Mustafa,
die Formel funktioniert in der 1. Zeile einwandfrei. Ab der 2. Zeile kommt allerdings der Fehler #BEZUG. Ich hab zwar einiges probiert, komme aber nicht dahinter was falsch ist.
Besten Dank für die Hilfe und Servus, Walter

Anzeige
AW: Noch nicht ganz ...
14.07.2013 22:34:41
Mustafa
Hallo Walter,
entschuldige ich habe vergessen zu erwähnen das es eine MatrixFormel ist und mit Strg+Umschalt+Enter abgeschlossen werden muss.
Aber du hast ja schon eine funktionierenden VBA Code was ja dein eigentliches Anliegen war.
Danke für die Rückmeldung und Gruß aus Köln.

AW: VBA: besondere Auflistung
13.07.2013 16:00:34
ransi
Hallo Walter
Teste mal dies:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Sub aufruf()
    Dim arr As Variant
    Dim L As Long
    Dim I As Integer
    Dim myDic As Object
    Dim vntWert
    Dim out As Variant
    arr = Range("C5:O10").Value 'Anpassen
    Set myDic = CreateObject("Scripting.Dictionary")
    For L = LBound(arr) To UBound(arr)
        If Not myDic.exists(arr(L, 1)) Then
            myDic(arr(L, 1)) = WorksheetFunction.Index(arr, L)
            Else:
            For I = LBound(myDic(arr(L, 1))) To UBound(myDic(arr(L, 1)))
                If myDic(arr(L, 1))(I) = "" Then
                    vntWert = WorksheetFunction.Index(arr, L, I)
                    myDic(arr(L, 1)) = fncMachs(myDic(arr(L, 1)), I, vntWert)
                End If
            Next
        End If
    Next
    out = WorksheetFunction.Transpose(WorksheetFunction.Transpose(myDic.items))
    Range("Q5").Resize(UBound(out), UBound(out, 2)) = out 'Anpassen
End Sub


Function fncMachs(ByVal vnt As Variant, intIndex, Wert) As Variant
    vnt(intIndex) = Wert
    fncMachs = vnt
End Function


ransi

Anzeige
Perfekt, ich bin begeistert. Danke ransi! Walter
13.07.2013 19:32:45
WalterK

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige