Ich habe eine Liste, bestehend aus zwei Spalten, in den sich Buchstaben befinden.
Ich möchte wissen, ob der erste Teil einer Buchstabenkombination („XY“), beispielsweise „X“ in der ersten Spalte steht und der zweite Teil, beispielsweise „Y“ in der zweiten.
Mit der Formel
=A2:A39&B2:B39
verkette ich die beiden Spalten. Nun kann ich zählen:
=ZÄHLENWENN(D7#;D3)
Will ich allerdings die beiden Formeln zusammenbauen, versagt Excel:
=ZÄHLENWENN((A2:A39&B2:B39);D3)
Und ja – natürlich kann man das Problem (anders) lösen – beispielsweise so:
also: ZÄHLENWENN, leistet, was ich möchte: ein Befehl (ohne Schleife) und ich habe die Information (Wert in der Spalte oder nicht vorhanden). Ebenso verwende ich häufig SUMMEWENN:
Application.WorksheetFunction.SumIf
oder – um die Zeilennummer zu ermitteln VERGLEICH:
So spare ich mir das Schreiben von Schleifen. Nun wollte ich die kumulierten Geldbeträge zu bestimmten Monaten wissen. In Excel lautet die Funktion
=SUMMENPRODUKT((MONAT(A:A)=1)*(B:B))
also: summiere die Werte der Spalte B, wenn eine Datumsangabe in der Spalte A ein Datum des ersten Monats (Januar) im Jahr enthält. Klappt wunderbar. Und in VBA? Dort versagt eine Zeile wie:
Die Ursache ist schnell gefunden: Colums(1) = 1 kann nicht verarbeitet werden; auch nicht Month(Columns(1)); der Gleichheitsoperator in VBA ist nicht matrixfähig; „=“ kann nur identische Dinge vergleichen.
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:
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
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
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
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:
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
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
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.
