Get table data from a JSON array

diese weiterführenden Informationen sind sehr hilfreich. Aber ich muss mir diese erst an Hand Deiner Erklärungen erarbeiten.

Okay, freut mich zu hören. Dann leg ich nochmal ein einfaches funktionierendes Beispiel nach, wo man nur mit einem Array und ohne Formeln in der Tabelle auskommt.

Kopier den Code unten mal in eine neue Datei und lass Test einfach mal laufen. Wenn der Code anhält, dann kuck mal in das Tabellenblatt, das sind die Ausgangsdaten.

Dann debug den Code mal und schau Dir die Kommentare an, so könntest Du es auch machen. Ist sogar vielleicht einfacher zu verstehen?

Naja, wer die Qual hat... )

Andreas.

Option Explicit

Option Compare Text

Sub Test()

Dim Data

Dim i As Long, j As Long



'Zufallsdaten generieren

ReDim Data(1 To 20, 1 To 5)

For i = 1 To UBound(Data)

For j = 1 To UBound(Data, 2)

Data(i, j) = Int(Rnd * 9) + 1

Next

Next

'Überschriften

For j = 1 To UBound(Data, 2)

Data(1, j) = Chr(64 + RandomUnique(1, UBound(Data, 2)))

Next

'In die Tabelle

Range("A1").Resize(UBound(Data), UBound(Data, 2)) = Data



'Angenommen ich vergesse jetzt mal was ich grad gemacht habe

Stop



'Ich weiß das in der 1. Zeile der Daten die Überschriften steht

'Und ich soll A+C*E für jede Zeile rechnen



Const MyF = "=A+C*E"

Dim A As Long, C As Long, E As Long

Dim Temp As String



'Den Datenblock einlesen

Data = Range("A1").CurrentRegion



'Jetzt suche ich im Array die Überschriften und merke mir die Spalte

For j = 1 To UBound(Data, 2)

Select Case Data(1, j)

Case "A": A = j

Case "C": C = j

Case "E": E = j

End Select

Next



'Spalte hinzufügen

ReDim Preserve Data(1 To UBound(Data), 1 To UBound(Data, 2) + 1)

'Überschrift

Data(1, UBound(Data, 2)) = "Ergebnis " & MyF

For i = 2 To UBound(Data)

'Die Formel zusammenbauen

Temp = MyF

Temp = Replace(Temp, "A", Data(i, A))

Temp = Replace(Temp, "C", Data(i, C))

Temp = Replace(Temp, "E", Data(i, E))

'Und ausrechnen

Data(i, UBound(Data, 2)) = Application.Evaluate(Temp)

Next



'In die Tabelle zurück

Range("A1").Resize(UBound(Data), UBound(Data, 2)) = Data

End Sub

Private Function RandomUnique(ByVal Lo As Long, ByVal Hi As Long, _

Optional Reset As Boolean = False) As Long

Static Dict As Object 'Dictionary

'Init dictionary if necessary

If Dict Is Nothing Then Set Dict = CreateObject("Scripting.Dictionary")

'Remove all used numbers if forced from outside

If Reset Then Dict.RemoveAll

Do

'Get a random number

RandomUnique = Int((Hi - Lo + 1) * Rnd) + Lo

'Already used?

Loop Until Not Dict.Exists(RandomUnique)

'Remember it

Dict.Add RandomUnique, 0

'Automatic reset if all numbers used

If Dict.Count > Hi - Lo Then Dict.RemoveAll

End Function

Nach Farben kannst Du nicht filtern. Schreib in Spalte B r für rot, b für blau, s für schwarz und verwende eine Bedingte Formatierung, das geht und ist für die Handhabung auch einfacher.
Die eingeschobenen Zeilen mit der Jahreszahl machen das Leben nur unnötig schwer, bitte löschen. Wenn man die Daten dann als Tabelle formatiert kann man sich sehr einfach nach dem Jahr filter, mit z.B. einen Datenschnitt.
Create and format tables - Office Support
Use slicers to filter data - Office Support
Nach diesen Änderungen erübrigt sich Erfahrungsgemäß meistens das Aufsplitten in mehrere Dateien. Andernfalls benutze Power Query und importiere die Daten aus der Hauptmappe und setze die benötigten Filter gleich dort. Kuck mal hier, das geht auch mit Dateien:
Import from an Excel Table
Bei Änderungen kann man diese Mappe nun via Daten \ Alles Aktualisieren updaten oder in der Query so einstellen das dies automatisch beim Öffnen der Datei passiert.
Aber wie gesagt, aufsplitten ist, idR unnötig. Lade die Daten ggf. in ein Datenmodell (auch mit PQ und filtere ggf. Daten heraus) und lade die restlichen Daten in ein Datenmodell, das kann man dann zur Datenanalyse verwenden, in z.B. Pivottabellen.
Create a Data Model in Excel
Create a PivotTable to analyze worksheet data - Office Support
Andreas.

Sure, apply a data validation list to the cells

https://support.office.com/en-us/article/apply-...

So you can setup a list for each cells and get e.g. "frog" in the cell.

Now you can setup a table and search with VLOOKUP for "frog" and return the right value. (Or you can have a 1 into a cell and use VLOOKUP to return "frog").

https://support.office.com/en-us/article/vlooku...

Andreas.

Hi Abraham, I'm an independent adviser and will try to help.

When I make a new database, the first thing I do is make a list of all the data points that I need to capture. I then organize those data points into logical, normalized tables. The Foundation of any database is a well done normalized table structure.

What you might try to start with is tool or video rental structure to give you the base you want. You can search on 'database models' to find sights that have models to learn from.

This medium is more suited to asking specific questions, rather than a generalized tutorial. I hope I've provided some starting points for you. If you need further clarification please feel free to ask.

Wäre dies jetzt der Weg über definierte Namen?

Nee, die definierten Namen (benannte Zellen) brauchst Du nur wenn Du auf Zellen zurückgreifst von denen Du nicht weißt wo sie sind.

Klick mal irgendwo in die Tabelle und gibt in das Namenfeld (da wo A1 steht wenn Du auf Zelle A1 geklickt hättest, über der linken oberen Ecke der Tabelle) den Text asd ein und drück Enter.

Die angeklickte Zelle kann ich nach wie vor über Range("A1") ansprechen (wenn es denn A1 wäre), aber sie hat nun auch den zusätzlichen Namen "asd", den ich im Code genau wie "A1" verwenden kann:

Sub ASD()

MsgBox Range("asd").Address

End Sub

So kann (m)ein Makro auf Zellen zugreifen von denen es nicht weiß wo sie sind.

Also wenn Du Formeln statt die ausgerechneten Werte haben willst, dann ist erstmal der einfachste Weg die Zeile

Data(i, UBound(Data, 2)) = Application.Evaluate(Temp)

in

Data(i, UBound(Data, 2)) = Temp

abzuändern. Damit bekommst Du schon mal eine Formel... mit Werten, ist ja klar. ;-)

Anstatt der Werte brauchen wir den Zellbezug, und nun müssen wir mal kurz vorausschauen, denn es spielt es eine Rolle wohin wir das Array anschließend hinschreiben.

Außerdem müssen wir unsere Platzhalterformel von

Const MyF = "=A+C*E"

in

Const MyF = "=@A+@C*@E"

abändern, sonst gibt es Schwierigkeiten beim Suchen&Ersetzen mit REPLACE.

Wenn die erzeuge Formel =A2+C2*E2 lauten soll, dann funktioniert das nur wenn die linke obere Ecke des Array nachher in A1 steht.

Wir könnten das Array aber auch problemlos nach J23 schreiben, unsere absolute Formel wird aber nicht zu =J24+L24*N24 was sich aber dann muss.

[Zwischenrede Anfang]

Daher hat Excel das nette Feature der realtiven Bezüge, d.h. ich muss nicht unbedingt =B3 schreiben, ich könnte auch =R[-2]C[3] schreiben, d.h. diese Formel bezieht sich auf die Zelle, die "R[-2]" 2 Zeilen über und "C[3]" 3 Spalten rechts von der Zelle steht,
in der diese Formel eingegeben wurde.

Für unseren Fall würde dann sowas wie "=RC[-3]+RC[-2]*RC[-5]" für jede Zeile rauskommen:

For i = 2 To UBound(Data)

'Die Formel zusammenbauen

Temp = MyF

Temp = Replace(Temp, "@A", "RC[" & -A & "]")

Temp = Replace(Temp, "@C", "RC[" & -C & "]")

Temp = Replace(Temp, "@E", "RC[" & -E & "]")

'Und eintragen

Data(i, UBound(Data, 2)) = Temp

Next

Leider funktioniert das ganz nicht wenn wir ein Array in die Tabelle schreiben (gibt einen RTE 1004), das Range-Objekt will absolute Bezüge.

[Zwischenrede Ende]

Also muss ich mich schon jetzt beim erzeugen der Formel auf die Zelle beziehen, die nacher meine linke obere Ecke wird.

Das macht man am einfachsten mit WITH RANGE und referenziert die Zellbezüge über OFFSET:

With Range("A1")

For i = 2 To UBound(Data)

'Die Formel zusammenbauen

Temp = MyF

Temp = Replace(Temp, "@A", .Offset(i - 1, A - 1).Address)

Temp = Replace(Temp, "@C", .Offset(i - 1, C - 1).Address)

Temp = Replace(Temp, "@E", .Offset(i - 1, E - 1).Address)

'Und eintragen

Data(i, UBound(Data, 2)) = Temp

Next

'In die Tabelle zurück

.Resize(UBound(Data), UBound(Data, 2)) = Data

End With

das einzigste an was man dabei denken muss ist das man von der Zeile und Spalte immer 1 abzeihen muss, weil die Referenz von der linken oberen Ecke des Array auf die linken oberen Ecke des Array einem .OFFSET(0, 0) zu erzeugen wäre. => MsgBox Range("A1").Offset(0,
0).Address ergibt A1

Wenn Du es nun nach J23 haben willst, dann änderst Du nur das WITH ab:

With Range("J23")

und der Rest passt.

BTW, die $ aus den Formeln bekommt man weg wenn man die ersten 2 Argumente von ADDRESS auf FALSE setzt

Temp = Replace(Temp, "@A", .Offset(i - 1, A - 1).Address(0, 0))

Andreas.