Spalte mit VBA Bestimmen, Anschließend Berechnung

Hallo zusammen,
Heute komme ich mit einem Standardproblem ... ich stolper da immer wieder drüber, aber bis jetzt kann ich mir die Lösung nicht merken oder die richtigen Begriffe für Google finden ...
Ich habe eine Struktur in der ein "Modell Name" und Elemente (Sensoren) gespeichert sind. Nun gehe ich ein Array dieser Struktur nach und nach durch und suche das jeweilige Element in einer entsprechenden Tabelle. Aus dem gefundenen Wert extrahiere ich die Spalte.
In der Tabelle, in der ich den Wert gefunden habe, stehen Daten. Ich möchte nun nach und nach das Minimum, das Maximum, den Median und das arith. Mittel berechnen. Ich weiß, das ich dafür die WorksheetFunctions nehmen kann. Ich komme aber nicht auf die Bestimmung der Range.
Snippet bisher:
For i = 0 To UBound(Models)
For j = 0 To UBound(Models(i).Sensors)
Set srcCell = Worksheets(Models(i).ModelName).Cells.Find(Models(i).Sensors(j))
If Not srcCell = "" Then
'Split(srcCell.Address, "$")(1) 'results in column letter
Worksheets("Statistics").Cells(lastRow + j, 1) = Models(i).Sensors(j)
' Compute minimum, write in statistics column B
' Worksheets("Statistics").Cells(lastRow + j, 2) =
' Compute maximum, write in statistics column C
' Worksheets("Statistics").Cells(lastRow + j, 3) =
' Compute median, write in statistics column D
' Worksheets("Statistics").Cells(lastRow + j, 4) =
' Compute average, write in statistics column E
' Worksheets("Statistics").Cells(lastRow + j, 5) =
Else
End If
Next j
lastRow = lastRow + j
Next i
(warum das Forum das Snippet nicht als Code akzeptiert weiß ich nicht).
Mir kann bestimmt jemand weiterhelfen die entsprechende Range zu definieren ... Ich vermute, dass mit einem Konstrukt ala
Range(Cells(,Split(srcCell.Address, "$")(1)),Cells(,Split(srcCell.Address, "$")(1)))
gehen müsste. Aber ich bekomme es nicht so richtig hin.
Über sachdienliche Hinweise bin ich dankbar :)
Viele Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Nun habe ich einen Ansatz, der aber kuriose Probleme bereitet:

        For i = 0 To UBound(Models)
For j = 0 To UBound(Models(i).Sensors)
Set srcCell = Worksheets(Models(i).ModelName).Cells.Find(Models(i).Sensors(j))
If Not srcCell Is Nothing Then
srcCol = Split(srcCell.Address, "$")(1) 'results in column letter
Worksheets("Statistics").Cells(lastRow + j, 1) = Models(i).Sensors(j)
' Compute minimum, write in statistics column B
Worksheets("Statistics").Cells(lastRow + j, 2) = WorksheetFunction.Min( _
Worksheets(Models(i).ModelName).Range(Columns(srcCol).Column + 2 & ":" & Columns(srcCol).Column + 2))
' Compute maximum, write in statistics column C
Worksheets("Statistics").Cells(lastRow + j, 3) = WorksheetFunction.Max( _
Worksheets(Models(i).ModelName).Range(Columns(srcCol).Column + 2 & ":" & Columns(srcCol).Column + 2))
' Compute median, write in statistics column D
Worksheets("Statistics").Cells(lastRow + j, 4) = WorksheetFunction. _
Median(Worksheets(Models(i).ModelName).Range(Columns(srcCol).Column + 2 & ":" & Columns(srcCol).Column + 2))
' Compute average, write in statistics column E
'Worksheets("Statistics").Cells(lastRow + j, 5) = WorksheetFunction. _
Average(Worksheets(Models(i).ModelName).Range(Columns(srcCol).Column + 2 & ":" & Columns(srcCol).Column + 2))
Else
End If
Next j
lastRow = lastRow + j
Next i

Und zwar ergibt sich nun folgendes Problem: 16x funktioniert alles tadellos, ab 16 funktionieren Median und Average nicht mehr. Kommentier ich diese aus läuft das Makro zwar durch, allerdings habe ich immer Blockweise ein Ergebnis und Blockweise 0. Etwa so:
16x Minimum und Maximum Ergebnisse
27x Minimum und Maximum sind jeweils 0
16x Minimum und Maximum Ergebnisse
8x Minimum und Maximum sind jeweils 0
30x Minimum und Maximumm Ergebnisse
20x Minimum und Maximum sind jeweils 0
16x Minimum und Maximum Ergebnisse
25x Minimum und Maximum sind jeweils 0
16x Minimum und Maximum Ergebnisse
19x 0
16x Ergebnisse
15x 0
16x Ergebnisse
8x 0
16x Ergebnisse
22x 0
16x Ergebnisse
16x 0
Das Makro steigt mit dem Fehler
Laufzeitfehler '1004':
Die Median-Eigenschaft des WorksheetFunction Objektes kann nicht zugeordnet werden
(beziehungsweise mit der Average Funktion). Ich weiß nicht so recht weiter... die Spalten sind richtig. Bei Durchlauf 16 bin ich in Spalte AX bzw AX+2=AZ. Das stimmt und in der Spalte stehen auch Werte die ich mit der Excel eigenen Funktion auswerten kann. Aber warum steigt das Makro so musterhaft aus?
Wenn ich nun die erste Zeile

Worksheets("Statistics").Cells(lastRow + j, 1) = Models(i).Sensors(j)

gegen

Worksheets("Statistics").Cells(lastRow + j, 1) = Worksheets(Models(i).ModelName).Range(Cells(1, srcCol))

austausche, dann steigt das Makro direkt beim ersten Durchlauf aus. Also scheint was mit der Zuordnung nicht zu stimmen. Aber was!?
Ich hoffe mir kann jemand helfen :)
Viele Grüße

For i = 0 To UBound(Models) For j = 0 To UBound(Models(i).Sensors) Set srcCell = Worksheets(Models(i).ModelName).Cells.Find(Models(i).Sensors(j)) If Not srcCell Is Nothing Then srcCol = Split(srcCell.Address, "$")(1) 'results in column letter Set srcRange = Worksheets(Models(i).ModelName).Range(Columns(srcCol). _ Column + 2 & ":" & Columns(srcCol).Column + 2) Worksheets("Statistics").Cells(lastRow + j, 1) = Worksheets(Models(i). _ ModelName).Cells(1, srcCol) 'Models(i).Sensors(j) ' Compute minimum, write in statistics column B Worksheets("Statistics").Cells(lastRow + j, 2) = Application. _ WorksheetFunction.Min(srcRange) ' Compute maximum, write in statistics column C Worksheets("Statistics").Cells(lastRow + j, 3) = Application. _ WorksheetFunction.Max(srcRange) ' Compute median, write in statistics column D 'Worksheets("Statistics").Cells(lastRow + j, 4) = WorksheetFunction. _ Median(srcRange) ' Compute average, write in statistics column E 'Worksheets("Statistics").Cells(lastRow + j, 5) = WorksheetFunction. _ Average(srcRange) Else End If Next j lastRow = lastRow + j Next i

' Create statistics sheet Worksheets.Add after:=Worksheets("Report") With ActiveSheet .Name = "Statistics" .Range("A1") = "Sensor Tag" .Range("B1") = "Minimum" .Range("C1") = "Maximum" .Range("D1") = "Median" .Range("E1") = "Arith. Average" End With For i = 0 To UBound(Models) For j = 0 To UBound(Models(i).Sensors) Set srcCell = Worksheets(Models(i).ModelName).Cells.Find(Models(i).Sensors(j)) If Not srcCell Is Nothing Then srcCol = Split(srcCell.Address, "$")(1) 'results in column letter ' Convert column letter into column number srcColNum = Columns(srcCol).Column + 2 srcCol = SpaltenBuchstabe(srcColNum) Set srcRange = Worksheets(Models(i).ModelName).Range(srcCol & ":" & srcCol) _ ' Extract sensor name Worksheets("Statistics").Cells(lastRow + j, 1) = Worksheets(Models(i). _ ModelName).Cells(1, srcCol) 'Models(i).Sensors(j) ' Compute minimum, write in statistics column B Worksheets("Statistics").Cells(lastRow + j, 2) = Application. _ WorksheetFunction.Min(srcRange) ' Compute maximum, write in statistics column C Worksheets("Statistics").Cells(lastRow + j, 3) = Application. _ WorksheetFunction.Max(srcRange) ' Compute median, write in statistics column D Worksheets("Statistics").Cells(lastRow + j, 4) = WorksheetFunction. _ Median(srcRange) ' Compute average, write in statistics column E Worksheets("Statistics").Cells(lastRow + j, 5) = WorksheetFunction. _ Average(srcRange) Else End If Next j lastRow = lastRow + j Next i

Beliebteste Forumthreads (12 Monate)

Spalte mit VBA Bestimmen, Anschließend Berechnung

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread