Automatische Abfrage mehrerer Inhalte

[Ego]

Hallo dsievert,

ich hab in der Anlage einmal Edgars Formel in drei Spalten eingetragen.

Aber du weist, dass du allein 2288 Firmen zur Kategorie "Biotechnologie" hast?
Bei dieser Lösung müstest du die Formel in mindestens 2288 Spalten kopieren (bei 1.500 Zeilen mehr als 3 Mil. Zellen). Bei jeder Änderung im Arbeitsblatt "Tabelle" würden dann die ca 35.000 Zeilen mehr als 3 Milionen mal ausgewertet. Dabei sind natürlich nur ca 35.000 Zellen belegt.
Meine Excelversion hatte schon bei 20 Spalten schlapp gemacht (kam mit der Anzeige der Zellen nicht mehr nach).

Eine sehr einfache Möglichkeit zu einer Kategorie alle Firmen anzeigen zu lassen, ist eine Pivottabelle. Leider kann ich das Beispiel nicht hochladen, da die Pivottabelle die Daten intern dupliziert und damit die Datei zu gross zum hochladen ist.

Eine andere Möglichkeit alle Firmen zu allen gewünschten Kategorien anzeigen zu lassen, wäre ein Makro. Wenn beide Tabellen sortiert sind, würden in dem Beispiel nur ca 36.500 Zellen gelesen und maximal 35.000 Zellen geschrieben. Ausserdem würden bei einer Änderung im Arbeitsblatt "Tabelle" keine Neuberechnungen durchgeführt, da das Ergebnis erst bei einem neuen Aufruf des Makros überarbeitet wird.

[Ego]

Hallo dsievert,

jetzt einmal mit VBA:

Code:

Private Sub cmdAuswerten_Click()
Dim lngZeileKat As Long
Dim lngZeileArr As Long
Dim lngOffsetZeile As Long
Dim lngOffsetSpalte As Long

Dim strAktKat As String

Dim bolEnde As Boolean

Dim varArr As Variant
Dim rngAnfang As Range

varArr = ThisWorkbook.Names("Daten").RefersToRange.Value
Set rngAnfang = ThisWorkbook.Names("Anfang").RefersToRange

bolEnde = False
lngZeileArr = 1
lngOffsetZeile = 0
lngOffsetSpalte = 0
strAktKat = rngAnfang.Offset(lngOffsetZeile, 0).Value

While lngZeileArr <= UBound(varArr, 1) And Not bolEnde
    If strAktKat = "" Then
        bolEnde = True
    Else
        If UCase(strAktKat) = UCase(varArr(lngZeileArr, 1)) Then
            lngOffsetSpalte = lngOffsetSpalte + 1
            rngAnfang.Offset(lngOffsetZeile, lngOffsetSpalte).Value = varArr(lngZeileArr, 2)
            lngZeileArr = lngZeileArr + 1
        ElseIf UCase(strAktKat) < UCase(varArr(lngZeileArr, 1)) Then
            lngOffsetSpalte = 0
            lngOffsetZeile = lngOffsetZeile + 1
            strAktKat = rngAnfang.Offset(lngOffsetZeile, 0).Value
        Else
            lngOffsetSpalte = 0
            lngZeileArr = lngZeileArr + 1
        End If
    End If
Wend

MsgBox "fertig"

End Sub

[dsievert]

jetzt einmal mit VBA:

wow vielen lieben Dank für deine Bemühungen! Genau so hab ich mir das vorgestellt - Danke für deine ganzen Mühen!

[steve1da]

Hallo steve1da,

leider ist es bei mir doch etwas später geworden mit der Rückmeldung.
Leider hab ich es nicht geschafft das mit der Formel hinzubekommen. Ich vermute das es damit zusammenhängt, das der Bezug über zwei Arbeitsblätter gemacht werden soll.
Um das klarer zu machen hab ich mal meine Arbeitsmappe angehängt. 
Könntest du dir das evtl nochmal anschauen? Ich wäre dir super dankbar, da ich eine Modifikation der Formel nicht derart hinbekommen habe als das es funktionieren würde...

Hola,

soweit ich das sehe macht die Formel doch genau was du willst. Auf Grund der Menge der Daten ist sie natürlich sehr langsam, mit dem Makro hast du ja eine funktionierende Lösung.

Gruß,
steve1da