Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1324to1328
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

Summe eines Vektors eines Array

Summe eines Vektors eines Array
30.07.2013 15:37:03
JACKD
Hallo ihr Lieben
Jetzt gehts wirklich nicht mehr weiter für mich -.-
Über eine Function Einnahmen lese ich mir Werte aus die dem Wert selJahr entsprechen
(Ich seh grad ich muss das Optional noch raushauen)
Und übergebe die Einnahmen wieder zurück in das andere Modul (diese Trägt sie dann im weiteren in eine Tabelle ein. Nun ist es aber so, dass ich gern die Werte des 6. Vektors addieren möchte (entspricht der 6. Spalte der Ursprungstabelle) dies bekomm ich aber nicht auf die reihe. Gibt es dafür ne schöne Lösung?
Public Function Einnahmenarray(Optional selJahr As Integer)
Dim arrTmp, i, S As Integer, objDaten As Object
Dim arrDaten(), arrKeys
''Letzte Zeile
LNEEinnahmenlZeile = Worksheets("Einnahmen").Cells(Rows.Count, 4).End(xlUp).Row
Set objDaten = CreateObject("scripting.dictionary")
'Tabelle in Array
arrTmp = Sheets("Einnahmen").Range("A1:H" & LNEEinnahmenlZeile)
'Zeilennummern sammeln
For i = 2 To UBound(arrTmp)
If Year(arrTmp(i, 2)) = selJahr Then
objDaten(i) = 0
End If
Next i
'Array für Fundstellen
If objDaten.Count Then
ReDim arrDaten(1 To objDaten.Count, 1 To 8)
arrKeys = objDaten.keys
For i = 0 To UBound(arrKeys)
For S = 1 To UBound(arrTmp, 2)
arrDaten(i + 1, S) = arrTmp(arrKeys(i), S)
Next S
Next
Einnahmenarray = arrDaten
Else
''Wenn keine Werte vorhanden
ReDim arrDaten(1 To 2, 1 To 8)
For i = 0 To 1
For S = 1 To 8
arrDaten(i + 1, S) = "0"
Next S
Next
Einnahmenarray = arrDaten
End If
End Function
ADDITIONAL
vielleicht hat jemand noch ne Idee wie ich folgendes Umsetzen kann..
ich möchte im Weiteren auch noch anders PRüfen (also Nach Quartalen und Monaten) Ich grübel schon ne ganze Weile wie ich das programmatisch umsetze, hab aber leider noch keinen Zweig grüner Art gefunden.
Bis dahin
thanks in advance

32
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Summe eines Vektors eines Array
30.07.2013 15:54:47
Rudi
Hallo,
1. meineSumme=WorksheetFunction.Sum(WorksheetFunction.Index(DasArray, 0, 6))
2. als Idee
Public Function Einnahmenarray(intSel As Integer, selType As String)
Dim arrTmp, i, S As Integer, objDaten As Object
Dim arrDaten(), arrKeys
''Letzte Zeile
LNEEinnahmenlZeile = Worksheets("Einnahmen").Cells(Rows.Count, 4).End(xlUp).Row
Set objDaten = CreateObject("scripting.dictionary")
'Tabelle in Array
arrTmp = Sheets("Einnahmen").Range("A1:H" & LNEEinnahmenlZeile)
'Zeilennummern sammeln
For i = 2 To UBound(arrTmp)
Select Case selType
Case "Y"
If Year(arrTmp(i, 2)) = intSel Then
objDaten(i) = 0
End If
Case "M"
If Month(arrTmp(i, 2)) = intSel Then
objDaten(i) = 0
End If
End Select
Next i

Gruß
Rudi

Anzeige
AW: Summe eines Vektors eines Array
30.07.2013 16:09:37
JACKD
Hallo Rudi
danke für deine Vorschläge.
Also die Summe spuckt bei mir "0" aus .. was mich dabei auch noch irritiert, das du mit index(array,0, 6) also mit 0 ansprichst (ist das dann nicht Zeile 0 )?
Zu deinem anderen Vorschlag.. er klingt auf jeden Fall Vielversprechend.. werde ihn versuchen in die Tat umzusetzen
Grüße

Das glaube ich gern, denn WshFunction ...
30.07.2013 16:32:43
Luc:-?
…lässt idR nicht die ZellFml-„Spielerchen“ zu, Jack;
Rudi wollte mit 0 alle Zeilen ansprechen, was der WshFct-Container offensichtl nicht zulässt. Wähle den anderen Array-Typ (falls du das nicht schon getan hast - so genau habe ich mir das nicht angesehen, aber wohl eher nicht → hatte 2Dimensionalität entdeckt!).
Luc :-?

Anzeige
Jepp Lässt er nicht zu owT
30.07.2013 16:40:29
JACKD
owT. ohne weiteren Text

AW: Summe eines Vektors eines Array
30.07.2013 20:20:26
Rudi
Hallo,
in dem Fall
Sub Jack()
Dim a, x
a = Cells(1, 1).CurrentRegion
x = WorksheetFunction.Sum(WorksheetFunction.Index(a, 0, 6))
End Sub

funktioniert das (x=55).
Wenn ich die 0 weglasse, bekomme ich nen Fehler 'Argument ist nicht optional'.
Auch in der Tabellenfunktion kann man die 0 angeben.
11111111 55
22222222  
33333333  
44444444  
55555555  
66666666  
77777777  
88888888  
99999999  
1010101010101010  

ZelleFormel
J1=SUMME(INDEX(A:H;0;6))

Gruß
Rudi

Anzeige
Interessant
30.07.2013 21:50:06
JAck
Hallo Rudi
Hast recht.. hab es grad mit deinem Beispiel Probiert, und siehe da es läuft.
Dann hab ich es in dem eigentlichen Code probiert und plubb.. geht nicht Ergebnis =0
Könnte die Ursache in leeren Zellen liegen? Oder ist es eher so wie Luc meint, das es falsch gedimt ist?
Grüße

Die Summe eines Vektors eines Arrays ...
30.07.2013 16:25:16
Luc:-?
…lässt sich sehr leicht ermitteln, Jack,
wenn du den entsprd Array-Typ verwendest. Bei einem klassischen 2dim-VBA-Array geht das evtl so, wie Rudi vorgeschlagen hat (mit Sicherheit über Evaluate, aber das wird hier unnötig umständlich). Hättest du aber einen Variant mit einem Array, wie ich dir das wohl schon mal empfohlen hatte (Verweis auf meine UDF Collect), wäre das auch anders möglich.
Bsp: Dim avDaten(5) As Variant für 6 Elemente, dann meinethalben 6 Zeilen (oder Spalten) einlesen → For ix = 0 To 5: avDaten(ix) = range("xyz").rows(ix + 1): Next ix
Damit erhältst du ein Array, dessen Einzelwerte mit avDaten(i)(j) identifiziert wdn. avDaten(i) identifiziert dann eine ganze Zeile, was du so mit einem klassischen VBA-Array nicht machen kannst. Die Summe wäre dann zlSumme(i) = WorksheetFunction.Sum(avDaten(i)).
Gruß Luc :-?

Anzeige
Dafür hier weiter
30.07.2013 16:47:12
JACKD
Hallo Luc,
danke auch für deine Anteilnahme.
Wenn du so nett wären könntest, und mir sagst, wo ich da was ändern muss? ich krieg das nicht auf die Reihe -.-
Public Function Einnahmenarray(ByVal selJahr As Integer, ByVal selMonat As Integer, ByVal  _
selType As String)
Dim arrTmp, i, S As Integer, objDaten As Object
Dim arrDaten(), arrKeys
''Letzte Zeile
LNEEinnahmenlZeile = Worksheets("Einnahmen").Cells(Rows.Count, 4).End(xlUp).Row
Set objDaten = CreateObject("scripting.dictionary")
'Tabelle in Array
arrTmp = Sheets("Einnahmen").Range("A1:H" & LNEEinnahmenlZeile)
'Zeilennummern sammeln
''Jahr/Quartal/Monat
Select Case selType
Case Is = "Jahr"
For i = 2 To UBound(arrTmp)
If Year(arrTmp(i, 2)) = selJahr Then
objDaten(i) = 0
End If
Next i
Case Is = "Monat"
For i = 2 To UBound(arrTmp)
If Month(arrTmp(i, 2)) = selMonat Then ' And Year(arrTmp(i, 2)) = selJahr
objDaten(i) = 0
End If
Next i
End Select
'Array für Fundstellen
If objDaten.Count Then
ReDim arrDaten(1 To objDaten.Count, 1 To 8)
arrKeys = objDaten.keys
For i = 0 To UBound(arrKeys)
For S = 1 To UBound(arrTmp, 2)
arrDaten(i + 1, S) = arrTmp(arrKeys(i), S)
Next S
Next
Einnahmenarray = arrDaten
Else
''Wenn keine Werte vorhanden
ReDim arrDaten(1 To 2, 1 To 8)
For i = 0 To 1
For S = 1 To 8
arrDaten(i + 1, S) = "0"
Next S
Next
Einnahmenarray = arrDaten
End If
End Function
Hier wird das Array ja definiert und dann weiter gegeben.
Muss ich das im Anschluss (in der Aufrufenden Prozedur) oder gleich hier in nen Variant bringen?
Ergänzend ergibt sich grad folgendes Problem
Case Is = "Monat"
For i = 2 To UBound(arrTmp)
If Month(arrTmp(i, 2)) = selMonat And Year(arrTmp(i, 2)) = selJahr Then 'HIER
objDaten(i) = 0
End If
Next i

Wenn ich das Kriterium um das Jahr erweitere Bringt er mir kein ergebnis
Ganz seltsam find ich die tatsache das ich das nicht im Einzelschritt debuggen kann -.-
Da bringt er auch bei Jahr keinen Wert
Grüße
und Thanks in advance

Anzeige
Unerfindliches Problem ist auf seltsame Weise..
30.07.2013 16:51:49
JACKD
verschwunden...
keine ahnung warum, aber geht -.-
jetzt muss ich nur noch das quartal einpflegen und dann gehts weiter mit der Summe =)

DAs Array Problem ist noch offen
30.07.2013 21:17:47
JAck
Mit einer weiteren Ergänzung
Vielleicht kann man das gleich auf diesem Wege beheben.
Und zwar hat Excel für Mac nicht die möglichkeit das scripting dictionary zu verwenden. ( da fehlt wohl ne DLL)
Das heisst man müsste das umgehen .. vielleicht trifft das ja mit Luc´s vorschlag über ein?
Grüße

AW: DAs Array Problem ist noch offen
30.07.2013 21:29:32
Rudi
Hallo,
Und zwar hat Excel für Mac nicht die möglichkeit das scripting dictionary zu verwenden. ( da fehlt wohl ne DLL)
das steht dir imho nur unter Windows zur Verfügung.
Alternative zum Unikate sammeln: Collection-Objekt
Gruß
Rudi

Anzeige
Richtig
30.07.2013 21:32:52
JAck
Rudi.. genau das war auch das was ich bei Tante Google dazu gefunden hab.
Ich mach mich zu dem Thema parallel noch bei Macuser schlau.. vielleicht hat da irgendein Fuchs schon eine DLL geschrieben.
Scheint aber eher unwahrscheinlich.
WAs macht denn Das Collection.Objekt? bzw. wie kann man damit umgehen? Würde das auch das SummenProblem lösen?
Grüße
und vielen Dank für deine Mühe

AW: Richtig
30.07.2013 21:53:56
Rudi
Hallo,
Würde das auch das SummenProblem lösen?
Nein.
Geh doch einfach mit ner schleife durch das Array
for i=lbound(arr) to ubound(arr)
sum=sum+arr(i,6)
next
Geht ratzfatz.
Gruß
Rudi

Anzeige
AW: Richtig
30.07.2013 22:01:15
JAck
Das hatte ich auch schon überlegt..
hatte mich dann allerdings an deine wort erinnert, dass schleifen idR mehr Zeit brauchen als direkte abfragen.
Wenn ich dich schonmal am Hörer hab, und wenn du so nett wärst,
gibt es auch eine einfache Methode 2 2Dimensionale arrays zu mergen ?
also array1
1,1,1
2,2,2
und array2
3,3,3
4,4,4
soll dann array3 ergeben
1,1,1
2,2,2
3,3,3
4,4,4
Du weisst sicher sofort die richtige Antwort ;-D
Grüße

Arrays mergen
30.07.2013 22:42:19
Rudi
Hallo,
auch das nur per Schleife.
dim arr3()
redim arr3( 1 to ubound(arr1)+ubound(arr2), 1 to 3)
for i=1 to ubound(arr1)
for j=1 to 3
arr3(i,j)=arr1(i,j)
next
next
for i=1 to ubound(arr2)
for j=1 to 3
arr3(i,j)=arr1(i+ubound(arr1),j)
next
next
Schleifen über Arrays sind nicht zeitkritisch.
Gruß
Rudi

Anzeige
AW: Arrays mergen
30.07.2013 22:59:54
JAck
Vielen Dank Rudi..
Hab zwar für die unmittelbare Fragestellung jetzt eine andere Lösung gefunden (klapper einfach beide Arrays ab, und "hau" die dann erst in der Ausgabe hintereinander
Aber ich glaub ich brauch es im weiteren noch für andere Auswertungen.
Vielen Dank dir einstweilen
und nene tollen Abend =)
Grüße

AW: Arrays mergen
30.07.2013 22:59:57
JAck
Vielen Dank Rudi..
Hab zwar für die unmittelbare Fragestellung jetzt eine andere Lösung gefunden (klapper einfach beide Arrays ab, und "hau" die dann erst in der Ausgabe hintereinander
Aber ich glaub ich brauch es im weiteren noch für andere Auswertungen.
Vielen Dank dir einstweilen
und nene tollen Abend =)
Grüße

Anzeige
Lösung mit Collection
31.07.2013 10:42:29
Rudi
Hallo,
Sub JAck()
Dim x
x = EinnahmenArray(2012)
MsgBox WorksheetFunction.Sum(WorksheetFunction.Index(x, 0, 6))
End Sub
Public Function EinnahmenArray(Optional selJahr As Integer)
Dim i As Long, s As Integer
Dim arrDaten(), arrTmp
Dim objCol As New Collection
'Tabelle in Array
arrTmp = Sheets("Einnahmen").Cells(1, 1).CurrentRegion
'Zeilennummern sammeln
For i = 2 To UBound(arrTmp)
If Year(arrTmp(i, 2)) = selJahr Then
objCol.Add i, CStr(i)
End If
Next i
'Array für Fundstellen
If objCol.Count Then
ReDim arrDaten(1 To objCol.Count, 1 To UBound(arrTmp, 2))
For i = 1 To objCol.Count
For s = 1 To UBound(arrTmp, 2)
arrDaten(i, s) = arrTmp(objCol(i), s)
Next s
Next
EinnahmenArray = arrDaten
Else
'Wenn keine Werte vorhanden
ReDim arrDaten(1 To 1, 1 To UBound(arrTmp, 2))
For s = 1 To UBound(arrTmp, 2)
arrDaten(1, s) = 0
Next s
EinnahmenArray = arrDaten
End If
End Function

Gruß
Rudi

AW: Lösung mit Collection
31.07.2013 15:43:01
JACKD
Sieht auf den ersten Blick ganz gut aus Rudi...
Ich versuch es mal einzubasteln =)und geb dir gleich bescheid =)
Grüße
Und vielen Dank für deine Mühen
(Und sorry ich hab heut 2 -3 mal auf den Thread geschaut aber den Arm da unten hab ich nicht gesehen)
mea culpa

AW: Lösung mit Collection
31.07.2013 15:54:32
JACKD
Same shit different day..
also er liesst die Collection ein (hab ich zwar jetzt nicht probiert) aber müsste sie auch wieder ausgeben
Die Worksheetfunction funzt dennoch nicht -.-
i´m totally over with my latein =)

Du baust eine UDF; wo willst du sie ...
31.07.2013 16:15:39
Luc:-?
…einsetzen, Jack?
Falls die Collection ObjektReferenzen enthält, kannst du den Einsatz in Fmln des TabBlattes vergessen. Ab Xl12 scheint die Steuerung der FmlErgebnisWiedergabe die Abbildung von ObjektSammlungen (auch mit Union für unzusammenhängende Bereiche!) zu verhindern. Sie wdn anscheinend zwar richtig ausgegeben, aber nicht dargestellt (#WERT!).
Anderenfalls liegt der Fehler woanders. Allerdings wäre es mit dem richtigen Array-Typ ohnehin viel einfacher. Darüber haben wir mM nach schon mal diskutiert. Außerdem hatte ich darüber schon mehrfach geschrieben. Bemüh' mal das Archiv!
Gruß Luc :-?

AW: Du baust eine UDF; wo willst du sie ...
31.07.2013 16:46:00
JACKD
Hallo Luc
Wo will ich sie einsetzen ..
Um kurz die Idee zu erläutern
Ich will eine Art einfache UST voranmeldung machen.
Dazu muss ich die Werte von verschiedenen Zeitfenstern betrachten, als auch mit verschiedenen Steuermerkmalen.
Also dachte ich mir (damit ich die einzelnen Makros übersichtlich halte, ich schick das mit parametern rüber in ne UDF)
Im derzeitigen Ergebnis sieht das so aus
Private Sub CMDBAuswertung_Click()
Dim selJahr As Integer
Dim selQuart, selMon As Integer
Dim selType As String
Dim Einnahmen, Ausgaben
Dim lzeile, iSum As Long
Dim SumUST, SumVST, SumMWSTZahlLast, Sum7VST, Sum19VST, Sum7UST, Sum19UST As Double
Dim Last As Boolean
With Me
selJahr = .CBZeitJahr
selQuart = .CBZeitQuartal
selMon = .CBZeitMonat.ListIndex + 1
Select Case True
Case .CBAuswertungArt = "Einkommensteuer"
'' Auswertung Einkommensteuer!''
MsgBox .CBAuswertungArt & selJahr
Exit Sub
Case .CBAuswertungArt = "Umsatzsteuer"
''Auswertung Umsatzsteuer"
Select Case True
Case .OPAuswertungJahr = True
selType = "Jahr"
Case .OPAuswertungQuartal = True
selType = "Quartal"
Case .OPAuswertungMonat = True
selType = "Monat"
End Select
Einnahmen = EinnahmenArray(selJahr, selMon, selQuart, selType) 'Hier Übergabe an  _
UDFEinnahmen
Ausgaben = Ausgabenarray(selJahr, selMon, selQuart, selType)
End Select
End With
''Summe Einnahmen
For iSum = LBound(Einnahmen) To UBound(Einnahmen)
SumUST = SumUST + Einnahmen(iSum, 6)
Next iSum
For iSum = LBound(Ausgaben) To UBound(Ausgaben)
SumVST = SumVST + Ausgaben(iSum, 6)
Next iSum
SumMWSTZahlLast = SumUST - SumVST
'''7% Vorsteuer
For iSum = LBound(Ausgaben) To UBound(Ausgaben)
If WorksheetFunction.Round(Ausgaben(iSum, 4), 2) = "0,07" Then
Sum7VST = Sum7VST + Ausgaben(iSum, 6)
End If
Next iSum
'''19% Vorsteuer
For iSum = LBound(Ausgaben) To UBound(Ausgaben)
If WorksheetFunction.Round(Ausgaben(iSum, 4), 2) = "0,19" Then
Sum19VST = Sum19VST + Ausgaben(iSum, 6)
End If
Next iSum
'''7% Umsatzsteuer
For iSum = LBound(Einnahmen) To UBound(Einnahmen)
If WorksheetFunction.Round(Einnahmen(iSum, 4), 2) = "0,07" Then
Sum7UST = Sum7UST + Einnahmen(iSum, 6)
End If
Next iSum
'''19% Umsatzsteuer
For iSum = LBound(Einnahmen) To UBound(Einnahmen)
If WorksheetFunction.Round(Einnahmen(iSum, 4), 2) = "0,19" Then
Sum19UST = Sum19UST + Einnahmen(iSum, 6)
End If
Next iSum
'''Eintragen nur zum PrŸfen
''Fehler (Keine Daten in dem Jahr""
With Sheets("Auswertung")
.Cells.Clear    'Blatt leeren
If SumUST - SumVST 
Dies kommt aus einer UF und geht dann in die UDF
Public Function EinnahmenArray(ByVal selJahr As Integer, ByVal selMonat As Integer, ByVal  _
selQuart As Integer, ByVal selType As String)
Dim arrTmp, i, s As Integer, objDaten As Object
Dim arrDaten(), arrKeys
Dim LNEEinnahmenlZeile As Long
''Letzte Zeile
LNEEinnahmenlZeile = Worksheets("Einnahmen").Cells(Rows.Count, 4).End(xlUp).Row
Set objDaten = CreateObject("scripting.dictionary")
'Tabelle in Array
arrTmp = Sheets("Einnahmen").Range("A1:H" & LNEEinnahmenlZeile)
'Zeilennummern sammeln
''Jahr/Quartal/Monat
Select Case selType
Case Is = "Jahr"
For i = 2 To UBound(arrTmp)
If Year(arrTmp(i, 2)) = selJahr Then
objDaten(i) = 0
End If
Next i
Case Is = "Monat"
For i = 2 To UBound(arrTmp)
If Month(arrTmp(i, 2)) = selMonat And Year(arrTmp(i, 2)) = selJahr Then
objDaten(i) = 0
End If
Next i
Case Is = "Quartal"
For i = 2 To UBound(arrTmp)
If Format(DateSerial(Year(arrTmp(i, 2)), Month(arrTmp(i, 2)) + (3 * 4), Day( _
arrTmp(i, 2))), "q") = selQuart And Year(arrTmp(i, 2)) = selJahr Then
objDaten(i) = 0
End If
Next i
End Select
'Array fŸr Fundstellen
If objDaten.Count Then
ReDim arrDaten(1 To objDaten.Count, 1 To 8)
arrKeys = objDaten.keys
For i = 0 To UBound(arrKeys)
For s = 1 To UBound(arrTmp, 2)
arrDaten(i + 1, s) = arrTmp(arrKeys(i), s)
Next s
Next
EinnahmenArray = arrDaten
Else
''Wenn keine Werte vorhanden
ReDim arrDaten(1 To 2, 1 To 8)
For i = 0 To 1
For s = 1 To 8
arrDaten(i + 1, s) = "0"
Next s
Next
EinnahmenArray = arrDaten
End If
End Function
Die UDF für die Ausgaben ist dann analog
Und zu dem Array Typen..
Das hab ich gestern schon gelesen. Und gefragt ob du mir dabei helfend unter die arme greifen kannst.
Ich bekomm es einfach nicht auf den Tacho das von dir vorgeschlagene umzusetzen. Wahrscheinlich fehlt mir dazu der Horizont.
Vielleicht kannst du es mir auch mit einfachen Worten versuchen nochmal nahe zu bringen... ?
Grüße und Vielen dank für deine Anteilnahme =)

Die Worksheetfunction ...
31.07.2013 16:19:44
Rudi
Hallo,
bei mir (WIN-Excel) funzt es. Wird also an Mac-Excel liegen.
Ergo per Schleife summieren.
Gruß
Rudi

Ergo per Schleife summieren? Das glaub' ...
31.07.2013 16:33:04
Luc:-?
…ich jetzt nicht, Rudi!
Warum bloß versteift ihr euch alle immer nur auf „klassische“ n-dimensionale VBA-Arrays?! Die sind ein Sonderfall, wenn man mal über den VBA-Tellerrand hinausschaut!
Gruß Luc :-?

AW: Die Worksheetfunction ...
31.07.2013 16:36:58
JACKD
Hallo Rudi.
Nee es liegt nicht am Mac, da ich grad am Doser sitz... WIN 7 und Office 2010 Prof. 32 Bit
Es ist mehr als seltsam.. denn auch hier tritt wieder das gleiche Phänomen. Isoliert (zb mit Currentregion) in der direktabfrage funktioniert es, aber wehe dem man geht über die Arrays.
Und momentan ist es auch per schleife gelöst.
Grüße

WorksheetFunction.Sum(avDaten(i)).
31.07.2013 16:52:27
Rudi
Hallo,
dummerweise versagt das, wenn avDaten(i) mehr als 65536 Elemente enthält.
Gruß
Rudi

Mal ein BspCode für das, was ich meine, ...
01.08.2013 02:38:04
Luc:-?
…Folks (hoffe, deine Arrays wdn nicht zu groß, Jack, aber viell geht das so auch eher):
Rem Arg1=0 gz Matrix, IntZ>0 ds Spalte, IntZ0 ds EWert(zl,sp),
'   DezZ
Function TestAr(Optional ByVal x As Double, Optional ByVal nurSumme As Boolean)
Dim s As Long, z As Long, avX, avY, y As Variant
On Error GoTo fx
avX = Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9))
Select Case Int(Abs(x)) * Sgn(x)
Case Is = 0:  avY = avX
Case Is  x: z = Int(Abs(x) - 1) Mod 3
s = ((Abs(x) - Int(Abs(x))) * 10 ^ (Len(CStr( _
Abs(x) - Int(Abs(x)))) - 2) - 1) Mod 3
avY = avX(z)(s): nurSumme = False
If x  0:  ReDim avY(UBound(avX))
For Each y In avX
avY(z) = y(x - 1): z = z + 1
Next y
avY = WorksheetFunction.Transpose(avY)
End Select
If nurSumme Then
TestAr = WorksheetFunction.Sum(avY)
Else: TestAr = avY
End If
fx: If CBool(Err.Number) Then TestAr = CVErr(Err.Number)
End Function
Gruß Luc :-?

-.-
01.08.2013 10:32:53
JACKD
Hallo Luc:
Also ich hab probiert deinen Code zu verstehen. Es gelingt mir nicht wirklich
Ich versuch es mal Stückweise
Rem Arg1=0 gz Matrix, IntZ>0 ds Spalte, IntZ0 ds EWert(zl,sp),
'   DezZ
Kommentare..
Function TestAr(Optional ByVal x As Double, Optional ByVal nurSumme As Boolean)
Dim s As Long, z As Long, avX, avY, y As Variant
On Error GoTo fx


avX = Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9))

Hier wird der Array "gefüllt"

Select Case Int(Abs(x)) * Sgn(x)

Die bitte nach nem einfachen Beispiel ist wohl spätestens hier gescheitert. Ich kannte die beiden Funktionen int() und sgn() zb nicht, Ansonsten Definition des Select case

Case Is = 0:  avY = avX

Eingangsmatrix = Ausgangsmatrix

Case Is  x: z = Int(Abs(x) - 1) Mod 3
s = ((Abs(x) - Int(Abs(x))) * 10 ^ (Len(CStr(Abs(x) - Int(Abs(x)))) - 2) - 1) Mod 3
avY = avX(z)(s): nurSumme = False
If x  0:  ReDim avY(UBound(avX))
For Each y In avX
avY(z) = y(x - 1): z = z + 1
Next y
avY = WorksheetFunction.Transpose(avY)
End Select
Versteh hier nur Bahnhof
    If nurSumme Then
TestAr = WorksheetFunction.Sum(avY)
Summe wenn nurSUmme wahr

Else: TestAr = avY
End If
fx: If CBool(Err.Number) Then TestAr = CVErr(Err.Number)
End Function
Ende
Also den Kern hab ich im wesentlichen nicht verstanden.
Vielleicht geht das ja auch einfacher? ohne deine ganz Operanten und Modulationen
Denn mal ehrlich (Ist das ganze INT; MOD; ABS notwendig)?
Mir hilft es auf jeden Fall nicht den Kern des ganzen zu umreisen, da mich der Rest viel zu sehr verunsichert.
By the Way wenn ich als übergabewert eine 5 eingebe, kommt Fehler 9 (Ich glaube, weil da das Z Null ist ..?)
Grüße und danke für deine Mühen

Na, dafür kann ja keiner außer dir, ...
01.08.2013 14:43:00
Luc:-?
…Jack,
wenn du den PgmCode nicht verstehst…! ;->
gz=ganze, IntZ=Ganzzahl, ds=diese, DezZ=Dezimalzahl, zl=Zeilen-/sp=Spaltenindex, EWert=Einzelwert, …bild=…bildung, f.=für
1. avX⇒ das Bsp-Array wird angelegt. Hier müsste bei einem Universal-Tool das analoge Umstrukturieren eines als Argument übergebenen Bereichs hin, um ein Datenfeld dieser Art zu bilden. Dabei kann das auch 1× für seine Zeilen und 1× für seine Spalten erfolgen (ggf noch pro Blatt), um die Flexibilität zu erhöhen (erspart das spätere Isolieren einzelner Spalten per For Each-Zyklus, vgl 4.3).
2. Richtig, aber nun kennst du sie ja wohl (Abs⇔ABSolut[er Betrag], Int⇔GANZZAHL, Sgn⇔VORZEICHEN). Das soll nur Argument1:=x als Ganzzahl von x als Dezimalzahl unterscheiden. Steht nur aus Übersichtlichkeitsgründen im Kopf, wäre aber mit x in Case Is <> x: vertauschbar.
3. Richtig, wobei Xl hier den Variant mit Datenfeld automatisch in eine normale 2D-XlMatrix transformieren kann (geht nicht mit jedem!).
4.1 Das ist im PgmKommentar erklärt. Mit zB x=2,2 wählt man einen Einzelwert aus dem Datenfeld. Da das hier 0-basiert ist (muss nicht immer so sein!), müssen beide Indizes um 1 verringert wdn. Außerdem wird mit der „Modulation“ sichergestellt, dass sich x nur im Rahmen der Matrix bewegt, also hier immer die Werte von 0…2 annimmt. Bei negativem x wird der Einzelwert negiert (nur, um bsphaft alle x-Wert-Möglichkeiten abzudecken).
4.2 Statt Case Is < 0: avY = avX(Abs(x + 1) Mod 3) könnte man auch Case Is < 0: x = Abs(x + 1) Mod 3: avY = avX(x) schreiben. Viell ist so besser zu erkennen, dass bei x:=negative Ganzzahl nur der dementsprd Zeilenvektor des Variants übernommen wird, während bei …
4.3 …der Spaltenvektor erst gebildet wdn muss, was man mit der Anlage von von _ vornherein 2 ggsätzlich orientierten DFeld-Variants vermeiden könnte (vgl 1.). Dabei hatte ich leider 1× Mod 3 vergessen, so dass es zum Fehler kam, den du eigentl nicht als Fehler 9 hättest sehen sollen. Korrektur:

Case Is > 0:  ReDim avY(UBound(avX)): x = (x - 1) Mod 3
For Each y In avX
avY(z) = y(x): z = z + 1
Next y
UBound kann sich hier nur auf die Zeilen des DFeldes beziehen! Wollte man auch die Spaltenanzahl ebenso feststellen, müsste man zB UBound(avX(0)) schreiben. Transpose stellt den Ergebnisvektor dann spaltenkonform senkrecht.
5. Richtig, dann wird kein Datenfeld (Matrix bzw Vektor) und auch kein Einzelwert zurückgegeben, sondern nur die Summe der bereitgestellten Werte gebildet (ist weiter ausbaufähig zu eigenem TEILERGEBNIS bzw AGGREGAT), was bei x:=Einzelwert-Indizierung natürlich sinnlos wäre und deshalb abgeblockt wird.
Fazit: Der Kern ist die Indizierung des DFeldes und was mit Weglassen des letzten Index, das bei n-dimensionalen xlVBA-Arrays unmöglich wäre, hier erreichbar ist! Die vbFktt Abs, Int und Sgn dienen hier nur dem Einsatzkomfort, würden aber in universellen Lösungen sicher ebenso benötigt wdn, je nachdem, was der Pgmierer berücksichtigen will.
Das HptProblem der Anwender wird wohl darin bestehen, dass weder VBE-Hilfe noch xlSites im Internet alle Möglichkeiten dieses Array-Typs behandeln (scheinen sogar weitgehend unbekannt zu sein, weil ich auch schon völlig Falsches bzw nur Halbrichtiges dazu dort gefunden habe!). Stattdessen wird der Anwender auf die unhandlichen n-dimensionalen Arrays förmlich gestoßen, aber die hat wohl nur VB(A/S). JavaScript zB kennt die nicht, nur die MS-Variante JScript kann sie verarbeiten.
Gruß Luc :-?

...und noch ein Bsp, ...
05.08.2013 20:03:53
Luc:-?
…dieses Mal diese „besondere“ Array-Bildung, zusätzl mit Auswertungsmöglichkeit für alle Spalten oder alle Zeilen m/o Fehler-Ignorierung (im GgSatz zu TEILERGEBNIS und AGGREGAT auch für DFelder!):
Rem Bildet Vektor aus Vektoren f.max 2-dim ZBereiche u.DFelder;
'   Arg1: ZBereich bzw DFeld aus Ausdruck; Arg2: 0/Falsch/fehlt
'   =Zeilen-, 1/Wahr=SpaltenOrientierg; Arg3: 0/fehlt=keine Re-
'   chenOperat, 1…11= w.m.Arg1 v.TEILERGEBNIS, 
Function VectAr(ByVal Bezug, Optional ByVal SpaltOrient As Boolean, _
Optional ByVal RechOp)
Dim isOTxF As Boolean, isBer As Boolean, ix As Long, nix As Long, tz As Long, _
OpTyp As Integer, avErg, xv, zwErg As Variant, bez As Range, xb As Range
On Error GoTo fx
If Not IsMissing(RechOp) Then
If Not IsNumeric(RechOp) Then Err.Raise xlErrNum
isOTxF = RechOp  11 Then Err.Raise xlErrNA
End If
isBer = TypeName(Bezug) = "Range"
With WorksheetFunction
If isBer Then
Set bez = Bezug
If SpaltOrient Then
ReDim avErg(bez.Columns.Count - 1)
For Each xb In bez.Columns
avErg(ix) = .Transpose(xb.Value2): ix = ix + 1
Next xb
Else: ReDim avErg(bez.Rows.Count - 1)
For Each xb In bez.Rows
avErg(ix) = .Transpose(.Transpose(xb.Value2)): ix = ix + 1
Next xb
End If
Else: On Error Resume Next
If IsError(LBound(Bezug, 2)) Then
If IsError(Bezug(LBound(Bezug))(LBound(Bezug))) Then
If SpaltOrient Then
avErg = .Transpose(Bezug)
Else: avErg = Bezug
End If
Else: avErg = Bezug
End If
Else: On Error GoTo fx
If Not SpaltOrient Then Bezug = .Transpose(Bezug)
nix = UBound(Bezug, 2) + 1 - LBound(Bezug, 2)
ReDim avErg(nix - 1), zwErg(UBound(Bezug, 1) - LBound(Bezug, 1))
For Each xv In Bezug
zwErg(tz) = xv: tz = (tz + 1) Mod nix
If tz = 0 Then avErg(ix) = zwErg: ix = ix + 1
Next xv
End If
End If
If Not IsMissing(RechOp) Then
ix = 0
For Each xv In avErg
If isOTxF Then
On Error Resume Next
tz = LBound(xv)
For Each zwErg In xv
If Not IsNumeric(zwErg) Then xv(tz) = ""
tz = tz + 1
Next zwErg
End If
Select Case OpTyp
Case 0:     avErg(ix) = xv
Case 1:     avErg(ix) = .Average(xv)
Case 2:     avErg(ix) = .Count(xv)
Case 3:     avErg(ix) = .CountA(xv)
Case 4:     avErg(ix) = .Max(xv)
Case 5:     avErg(ix) = .Min(xv)
Case 6:     avErg(ix) = .Product(xv)
Case 7:     avErg(ix) = .StDev(xv)
Case 8:     avErg(ix) = .StDevP(xv)
Case 9:     avErg(ix) = .Sum(xv)
Case 10:    avErg(ix) = .Var(xv)
Case 11:    avErg(ix) = .VarP(xv)
End Select
If isOTxF Then On Error GoTo fx
ix = ix + 1
Next xv
End If
End With
VectAr = avErg: GoTo ex
fx: If Err.Number > xlErrNull And Err.Number 
Viel Erfolg beim Ausprobieren! Luc :-?

Im Vorbereitungsteil für DFelder ist leider ...
05.08.2013 21:57:02
Luc:-?
…noch ein Fehler → wird so bald wie möglich korrigiert!
Luc :-?

Neue Vs m.Korrektur des Teils
06.08.2013 00:33:31
Luc:-?

Rem Bildet Vektor aus Vektoren f.max 2-dim ZBereiche u.DFelder;
'   Arg1: ZBereich bzw DFeld aus Ausdruck; Arg2: 0/Falsch/fehlt
'   =Zeilen-, 1/Wahr=SpaltenOrientierg; Arg3: 0/fehlt=keine Re-
'   chenOperat, 1…11= w.m.Arg1 v.TEILERGEBNIS, 
Function VectAr(ByVal Bezug, Optional ByVal SpaltOrient As Boolean, _
Optional ByVal RechOp)
Const azOpT As Integer = 12
Dim isOTxF As Boolean, isBer As Boolean, ix As Long, nix As Long, tz As Long, _
OpTyp As Integer, avErg, xv, zwErg As Variant, bez As Range, xb As Range
On Error GoTo fx
If Not IsMissing(RechOp) Then
If Not IsNumeric(RechOp) Then Err.Raise xlErrNum
isOTxF = RechOp  azOpT Then Err.Raise xlErrNA
End If
isBer = TypeName(Bezug) = "Range"
With WorksheetFunction
If isBer Then
Set bez = Bezug
If SpaltOrient Then
ReDim avErg(bez.Columns.Count - 1)
For Each xb In bez.Columns
avErg(ix) = .Transpose(xb.Value2): ix = ix + 1
Next xb
Else: ReDim avErg(bez.Rows.Count - 1)
For Each xb In bez.Rows
avErg(ix) = .Transpose(.Transpose(xb.Value2)): ix = ix + 1
Next xb
End If
Else: On Error Resume Next
If IsError(LBound(Bezug, 2)) Then
If IsError(Bezug(LBound(Bezug))(LBound(Bezug))) Then
If SpaltOrient Then
avErg = .Transpose(Bezug)
Else: avErg = Bezug
End If
Else: avErg = Bezug
End If
Else: On Error GoTo fx
If Not SpaltOrient Then Bezug = .Transpose(Bezug)
tz = 0: nix = UBound(Bezug, 1) + 1 - LBound(Bezug, 1)
ReDim avErg(UBound(Bezug, 2) - LBound(Bezug, 2)), zwErg(nix - 1)
For Each xv In Bezug
zwErg(tz) = xv: tz = (tz + 1) Mod nix
If tz = 0 Then avErg(ix) = zwErg: ix = ix + 1
Next xv
End If
End If
If Not IsMissing(RechOp) Then
ix = 0
For Each xv In avErg
If isOTxF Then
On Error Resume Next
tz = LBound(xv)
For Each zwErg In xv
If Not IsNumeric(zwErg) Then xv(tz) = ""
tz = tz + 1
Next zwErg
End If
Select Case OpTyp
Case 0:     avErg(ix) = xv
Case 1:     avErg(ix) = .Average(xv)
Case 2:     avErg(ix) = .Count(xv)
Case 3:     avErg(ix) = .CountA(xv)
Case 4:     avErg(ix) = .Max(xv)
Case 5:     avErg(ix) = .Min(xv)
Case 6:     avErg(ix) = .Product(xv)
Case 7:     avErg(ix) = .StDev(xv)
Case 8:     avErg(ix) = .StDevP(xv)
Case 9:     avErg(ix) = .Sum(xv)
Case 10:    avErg(ix) = .Var(xv)
Case 11:    avErg(ix) = .VarP(xv)
Case 12:    avErg(ix) = .Median(xv)
End Select
If isOTxF Then On Error GoTo fx
ix = ix + 1
Next xv
End If
End With
VectAr = avErg: GoTo ex
fx: If Err.Number > xlErrNull And Err.Number 
Korektur in Blau!
Luc :-?

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige