Tag Archives: Array

Ein Tag hat 24 Stunden. Eine Palette Bier hat 24 Dosen. Das kann kein Zufall sein!

Hallo René,

du bist ein Ass, danke, nun weiß ich wie man die einzelnen Elemente anspricht, nach Zeile und Spalte und habe meinen Code angepasst.

aber: in meinem Fall markiere ich ja vor Eingabe der UDF wie immer bei Matrixfunktionen 3 Zellen untereinander und möchte, dass 3 Ergebnisse aus einem neuen Array, das mit den gewonnenen Variablen arbeitet erscheint

Hallo Axel,

Ich habe die Array verkleinert … das Überwachungsfenster hat mir verraten, dass Matrix1(0, x) und Matrix2(0,x) nicht belegt sind.

Public Function Test1(S1 As Variant, R1 As Variant, S2 As Variant, R2 As Variant, R3 As Variant)
 
' Funktionsbeschreibung: Berechnet den Schnittpunkt einer Geraden mit einer Ebene,
' Inputselektion:  5 zusammenhŠngende Zellbereiche (S1,R1,S2,R2,R3)

' Variablen deklarieren
 Dim S1x As Double
 Dim S1y As Double
 Dim S1z As Double
 
 Dim R1x As Double
 Dim R1y As Double
 Dim R1z As Double
 
 Dim S2x As Double
 Dim S2y As Double
 Dim S2z As Double
 
 Dim R2x As Double
 Dim R2y As Double
 Dim R2z As Double
 
 Dim R3x As Double
 Dim R3y As Double
 Dim R3z As Double
 
 Dim x1 As Double
 Dim x2 As Double
 Dim x3 As Double
 
 Dim Loesung()
 Dim r As Double
 
 Dim ReturnArray(3)
 Dim DoTranspose As Boolean
 
 Dim Matrix1(2, 2) As Double ' (kann man das so deklarieren (Anzahl Zeilen/Spalten der Matrix)?
 Dim Matrix2(2, 0) As Double
 
 
 ' Bestimmen, ob Inputbereich horizontal oder vertikal ist
 If Application.Caller.Rows.Count > 1 Then
 DoTranspose = True
 Else
 DoTranspose = False
 End If
 
 
' Werte aus Inputselektion (Vektorkoordinaten und neue LŠnge) holen
 S1x = S1.Cells(1).Value
 S1y = S1.Cells(2).Value
 S1z = S1.Cells(3).Value
 
 R1x = R1.Cells(1).Value
 R1y = R1.Cells(2).Value
 R1z = R1.Cells(3).Value
 
 S2x = S2.Cells(1).Value
 S2y = S2.Cells(2).Value
 S2z = S2.Cells(3).Value
 
 R2x = R2.Cells(1).Value
 R2y = R2.Cells(2).Value
 R2z = R2.Cells(3).Value
 
 R3x = R3.Cells(1).Value
 R3y = R3.Cells(2).Value
 R3z = R3.Cells(3).Value
 
 'Matrizes bestimmen
 '3x3 Matrix
 Matrix1(0, 0) = R1.Cells(1).Value
 Matrix1(1, 0) = R1.Cells(2).Value
 Matrix1(2, 0) = R1.Cells(3).Value
 
 Matrix1(0, 1) = R2.Cells(1).Value * (-1)
 Matrix1(1, 1) = R2.Cells(2).Value * (-1)
 Matrix1(2, 1) = R2.Cells(3).Value * (-1)
 
 Matrix1(0, 2) = R3.Cells(1).Value * (-1)
 Matrix1(1, 2) = R3.Cells(2).Value * (-1)
 Matrix1(2, 2) = R3.Cells(3).Value * (-1)
 
 '1x1 Matrix
 Matrix2(0, 0) = S2.Cells(1).Value - S1.Cells(1).Value
 Matrix2(1, 0) = S2.Cells(2).Value - S1.Cells(2).Value
 Matrix2(2, 0) = S2.Cells(3).Value - S1.Cells(3).Value
 
 
 ' Berechnungen
 
 ' r berechnen
 
 Loesung = Application.WorksheetFunction.MMult(Application.WorksheetFunction.MInverse(Matrix1), Matrix2)
 
 r = Loesung(1, 1)
 
 MsgBox r

 ' Ergebnis berechnen (Koordinaten des Schnittpunkts nder Geraden mit der Ebene)
 ReturnArray(0) = S1x + r * R1x
 ReturnArray(1) = S1y + r * R1y
 ReturnArray(2) = S1y + r * R1y


' Output transponieren horizontal zu vertikal oder umgekehrt, falls n_tig
 If DoTranspose Then
 Test1 = Application.WorksheetFunction.Transpose(ReturnArray)
 Else
 Test1 = ReturnArray
 End If

' Ergebnis erscheint in den 3 Output-Zellen

End Function

was habe ich gestern gemacht? Wir haben ja herausgefunden, dass in der „Lösungs“-Zeile der Fehler steckt.

Ich habe das Datenfeld Matrix markiert und das Überwachungsfenster eingeschaltet. Dort habe ich festgestellt, dass der Wert an der Position 0 nicht belegt ist:

Da waren sie wieder – meine drei Probleme: Vergesslichkeit, Dings und das Andere.

Lieber René,

ich hoffe, es geht dir gut. Darf ich dir eine kurze Frage VBA stellen? Folgende Situation:

Ich habe eine geodätische Kuppel gebaut und möchte ein Gleichungssystem mit 3 Gleichungen und 3 Unbekannten zu lösen:

Function GleichungsSystemMatrix3x3und1x3Parameter(Matrix1 As Range, Matrix2 As Range) As Variant
GleichungsSystemMatrix3x3und1x3Parameter = Application.WorksheetFunction.MMult(Application.WorksheetFunction.MInverse(Matrix1), Matrix2)
End Function

Und jetzt kommts: Da kommen also 3 Parameter r, t und w raus (so will ich sie später nennen) und die hätte ich gerne in Variablen geschrieben und eben nicht gleich in die Excelzellen, wie das der obige Code halt macht.

Hättest du eine Idee und Lust zu helfen?

LG, Axel

moin Axel,

du musst die Arrays richtig zusammenbauen, dann klappt es. Das Überwachungsfenster hat mir geholfen.

Sub LösungBerechnen()
Dim Matrix(2, 2) As Double
Dim Lö1(2, 2) As Double
Dim R1 As Double
Dim R2 As Double
Dim R3 As Double
Dim T1 As Double
Dim T2 As Double
Dim T3 As Double
Dim W1 As Double
Dim W2 As Double
Dim W3 As Double
Dim L1 As Double
Dim L2 As Double
Dim L3 As Double

R1 = 5
R2 = 3
R3 = 2
T1 = -1
T2 = 2
T3 = 2
W1 = 7
W2 = 5
W3 = 8

L1 = 3
L2 = 4
L3 = 1

Matrix(0, 0) = R1: Matrix(1, 0) = R2: Matrix(2, 0) = R3
Matrix(0, 1) = T1: Matrix(1, 1) = T2: Matrix(2, 1) = T3
Matrix(0, 2) = W1: Matrix(1, 2) = W2: Matrix(2, 2) = W3

Lö1(0, 0) = L1: Lö1(1, 0) = L2: Lö1(2, 0) = L3

MsgBox GleichungsSystemMatrix3x3und1x3Parameter_L1(Matrix, Lö1)
MsgBox GleichungsSystemMatrix3x3und1x3Parameter_L2(Matrix, Lö1)
MsgBox GleichungsSystemMatrix3x3und1x3Parameter_L3(Matrix, Lö1)

End Sub

Function GleichungsSystemMatrix3x3und1x3Parameter_L1(Matrix1 As Variant, Matrix2 As Variant) As Double
Dim Lösung As Variant
Lösung = Application.WorksheetFunction.mmult(Application.WorksheetFunction.MInverse(Matrix1), Matrix2)
GleichungsSystemMatrix3x3und1x3Parameter_L1 = Lösung(1, 1)
End Function

Function GleichungsSystemMatrix3x3und1x3Parameter_L2(Matrix1 As Variant, Matrix2 As Variant) As Double
Dim Lösung As Variant
Lösung = Application.WorksheetFunction.mmult(Application.WorksheetFunction.MInverse(Matrix1), Matrix2)
GleichungsSystemMatrix3x3und1x3Parameter_L2 = Lösung(2, 1)
End Function

Function GleichungsSystemMatrix3x3und1x3Parameter_L3(Matrix1 As Variant, Matrix2 As Variant) As Double
Dim Lösung As Variant
Lösung = Application.WorksheetFunction.mmult(Application.WorksheetFunction.MInverse(Matrix1), Matrix2)
GleichungsSystemMatrix3x3und1x3Parameter_L3 = Lösung(3, 1)
End Function

Liebe Grüße :: Rene

Ich beurteile Menschen nicht nach Aussehen, Hautfarbe oder Religion. Sondern wie sie sich benehmen, wenn eine zweite Kasse geöffnet wird.

Das ist bösartig! In einem Exceldokument sollen Werte von Eigenschaftsfeldern, die von SAP kommen, in die Kopfzeile geschrieben werden. Also von:

Nach:

Der Befehl für diese Felder ist schnell gefunden:

ContentTypeProperties(„Target group“)

Das Makro:

Dim strTitle As String
Dim strLocation As String
Dim strTarget As String
Dim strType As String

strTitle = ThisWorkbook.BuiltinDocumentProperties("Title").Value
strLocation = ThisWorkbook.ContentTypeProperties("Location").Value
strTarget = ThisWorkbook.ContentTypeProperties("Target group").Value
strType = ThisWorkbook.ContentTypeProperties("Document type").Value

If strTitle <> "" Then strTitle = " " & strTitle
If strLocation <> "" Then strLocation = " " & strLocation
If strTarget <> "" Then strTarget = " " & strTarget
If strType <> "" Then strType = " " & strType

With ActiveSheet.PageSetup
    .LeftHeader = Replace(.LeftHeader, "Title", "Title" & strTitle)
    .LeftHeader = Replace(.LeftHeader, "Location", "Location" & strLocation)
    .LeftHeader = Replace(.LeftHeader, "Target group", "Target group" & strTarget)
    .LeftHeader = Replace(.LeftHeader, "Document type", "Document type" & strType)
End With

Ein Durchlauf mit leeren Feldern – klappt! Ein Durchlauf mit Daten bringt die Fehlermeldung 13: Typen unverträglich. Ich stutze. Ich untersuche die Inhalte. tatsächlich: die Daten, die aus Sharepoint kommen, sind keine Texte, sondern Datenfelder. Bestehend aus zwei Werten: Inhalt und ID. Sieht man aber nicht:

Nun das kann man abprüfen:

Dim strTitle As String
Dim strLocation As String
Dim strTarget As String
Dim strType As String

If TypeName(ThisWorkbook.BuiltinDocumentProperties("Title").Value) = "String()" Then
    If UBound(ThisWorkbook.BuiltinDocumentProperties("Title").Value) >= 0 Then
        strTitle = ThisWorkbook.BuiltinDocumentProperties("Title").Value(0)
    End If
ElseIf TypeName(ThisWorkbook.BuiltinDocumentProperties("Title").Value) = "String" Then
    strTitle = ThisWorkbook.BuiltinDocumentProperties("Title").Value
End If

If TypeName(ThisWorkbook.ContentTypeProperties("Location").Value) = "String()" Then
    If UBound(ThisWorkbook.ContentTypeProperties("Location").Value) >= 0 Then
        strLocation = ThisWorkbook.ContentTypeProperties("Location").Value(0)
    End If
ElseIf TypeName(ThisWorkbook.ContentTypeProperties("Location").Value) = "String" Then
    strLocation = ThisWorkbook.ContentTypeProperties("Location").Value
End If

If TypeName(ThisWorkbook.ContentTypeProperties("Target group").Value) = "String()" Then
    If UBound(ThisWorkbook.ContentTypeProperties("Target group").Value) >= 0 Then
        strTarget = ThisWorkbook.ContentTypeProperties("Target group").Value(0)
    End If
ElseIf TypeName(ThisWorkbook.ContentTypeProperties("Target group").Value) = "String" Then
    strTarget = ThisWorkbook.ContentTypeProperties("Target group").Value
End If

If TypeName(ThisWorkbook.ContentTypeProperties("Document type").Value) = "String()" Then
    If UBound(ThisWorkbook.ContentTypeProperties("Document type").Value) >= 0 Then
        strType = ThisWorkbook.ContentTypeProperties("Document type").Value(0)
    End If
ElseIf TypeName(ThisWorkbook.ContentTypeProperties("Document type").Value) = "String" Then
    strType = ThisWorkbook.ContentTypeProperties("Document type").Value
End If

If strTitle <> "" Then strTitle = " " & strTitle
If strLocation <> "" Then strLocation = " " & strLocation
If strTarget <> "" Then strTarget = " " & strTarget
If strType <> "" Then strType = " " & strType

With ActiveSheet.PageSetup
' -- schreibe nur rein, falls der Text noch nicht drinsteht.
    If InStr(1, .LeftHeader, "Title" & strTitle) = 0 Then
        .LeftHeader = Replace(.LeftHeader, "Title", "Title" & strTitle)
    End If
    If InStr(1, .LeftHeader, "Location" & strLocation) = 0 Then
        .LeftHeader = Replace(.LeftHeader, "Location", "Location" & strLocation)
    End If
    If InStr(1, .LeftHeader, "Target group" & strTarget) = 0 Then
        .LeftHeader = Replace(.LeftHeader, "Target group", "Target group" & strTarget)
    End If
    If InStr(1, .LeftHeader, "Document type" & strType) = 0 Then
        .LeftHeader = Replace(.LeftHeader, "Document type", "Document type" & strType)
    End If
End With

Und dann klappt es auch:

Manche Faultiere fahren den Kreislauf so weit runter, dass sie aus Versehen sterben. – Als ich das gelesen habe, habe ich mich erstmal aufrecht hingesetzt.

Doof! In einer intelligenten Tabelle habe ich drei Spalten: ID, Vorname und Nachname. XVERWEIS kann einen Vornamen finden:

=XVERWEIS(G2;tbl_Kunden[Nr];tbl_Kunden[Vorname])

XVERWEIS kann ALLE Vornamen (als Matrixfunktion) zurückgeben:

=XVERWEIS(G2:G9;tbl_Kunden[Nr];tbl_Kunden[Vorname])

XVERWEIS kann Vor- und Nachnamen (hätten wir noch mehr Informationen – so auch diese) zurückgeben:

=XVERWEIS(G2;tbl_Kunden[Nr];tbl_Kunden[Vorname]:tbl_Kunden[Nachname])

Aber leider: beides geht nicht: mehrere Spalten zurückgeben von mehreren IDs:

Schade!

Und ich habe mich nicht an die Spitze der Nahrungskette hochgearbeitet, um Vegetarier zu werden.

Hübsche Fehlermeldung: „Zu wenige Zeilenfortsetzungen“.

Die Ursache: Mit dem Makrorekorder wird der Befehl Datei / Öffnen (eine Textdatei) aufgezeichnet. Da die Textdatei zirka 200 Spalten hat, kann dies nicht in einem Array gespeichert werden, der in diesem Makro intern verwendet wird:

Himmiherrgotzsakramentzefixallelujaglumpfarregtz

Es ist schön, wenn Excel Assistenten zur Verfügung stellt. Beispielsweise einen zum Duplikate entfernen:

Da ich diese Funktionalität in einem umfangreichen Programm benötige, zeichne ich ihn mit dem Makrorekorder auf:

ActiveSheet.Range(„$A$1:$J$78“).RemoveDuplicates _
Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
, 8, 9, 10), Header:=xlYes

Der Parameter Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) gefällt mir nicht.

In der Hilfe steht, dass man ihn weglassen kann – dann würden alle Spalten verwendet werden. Ein Test zeigt: Das ist falsch. Lässt man den Parameter weg, passiert: GAR NICHTS!

Also programmieren wir den Parameter:

Dim intSpalten() As Integer
Dim i As Integer

ReDim intSpalten(0)
intSpalten(0) = 1
For i = 2 To ActiveSheet.Range(„A1“).CurrentRegion.Columns.Count
ReDim Preserve intSpalten(UBound(intSpalten) + 1)
intSpalten(UBound(intSpalten)) = i
Next

ActiveSheet.Range(„A1“).CurrentRegion.RemoveDuplicates _
Columns:=intSpalten, Header:=xlYes

Das Ergebnis ist eine Fehlermeldung:

Verwundert reibe ich mir die Augen. Probieren und eine lange Suche liefert das Ergebnis: Man muss das Array vom Typ Variant deklarieren. Und: der Parameter Columns verlangt den Wert in Klammern !?! Dann klappt es: die Spaltenanzahl des Assistenten „Duplikate entfernen“ wird dynamisch:

Dim intSpalten
Dim i As Integer

ReDim intSpalten(0)
intSpalten(0) = 1
For i = 2 To ActiveSheet.Range(„A1“).CurrentRegion.Columns.Count
ReDim Preserve intSpalten(UBound(intSpalten) + 1)
intSpalten(UBound(intSpalten)) = i
Next

ActiveSheet.Range(„A1“).CurrentRegion.RemoveDuplicates _
Columns:=(intSpalten), Header:=xlYes

PS: Ein Dankeschön an Dominik Petri für den Hinweis!

Teile eines Arrays können nicht geändert werden.

Warum kann ich eine Formel nicht löschen?

Ein Blick in die Bearbeitungsleiste zeigt, dass es sich hier um eine Array-Formel oder um eine Martixformel handelt. Man erkennt das an den geschweiften Klammern um die Funktion. Hier wurden mehrere Zellen markiert und die Funktion TREND wurde mit der Tastenkombination [Shift]+[Strg]+[Enter] beendet. Alle Zellen bilden eine Formel – man kann nicht einen Teil herauslöschen (übrigens auch keine Zeile einfügen). Sie müssen den gesamten Bereich markieren und dann löschen.

Eine Array-Formel (Matrixformel)

Eine Array-Formel (Matrixformel)