Microsoft Excel

Herbers Excel/VBA-Archiv

Spalte mit VBA Bestimmen, Anschließend Berechnung

Betrifft: Spalte mit VBA Bestimmen, Anschließend Berechnung von: BlackDevil
Geschrieben am: 09.09.2014 16:32:04

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

  

Betrifft: AW: Spalte mit VBA Bestimmen, Anschließend Berechnung von: Rudi Maintaire
Geschrieben am: 09.09.2014 17:09:28

Hallo,
die .Find-Methode gibt ein Range-Objekt zurück.
Anstatt

If Not srcCell = "" Then

muss es
If Not srcCell Is Nothing Then

heißen.
lastRow = lastRow + j

Damit wird LastRow zu 0,1,3,6,10,15,21,..... Willst du das?

Gruß
Rudi


  

Betrifft: AW: Spalte mit VBA Bestimmen, Anschließend Berechnung von: BlackDevil
Geschrieben am: 09.09.2014 21:08:09

Hallo

zunächst einmal zu lastRow: Die innere Schleife geht von 0 bis n. Die Länge ist jeweils unterschiedlich. Am Ende ist j=n und ich addiere zu lastRow das letzte j. Zahlenbeispiel: die Länge der Durchläufe seien 10 5 und 15. Dann wäre lastRow jeweils 12, 17, 32. Und das ist gewollt, damit die Liste jeweils am Ende fortgesetzt wird. Das funktioniert auch tadellos. Der initiale Wert von 2 ist auch gewollt, da in der ersten Zeile (lastRow=1) die Spaltentitel stehen ;)

Die Änderung mit Is Not srcCell is Nothing werde ich ändern. Funktioniert aber auch so (er findet die richtige Zelle). Die Frage ist nun, wie ich die Range Methode füttere damit ich die statistischen Werte berechnen kann :)


  

Betrifft: AW: Spalte mit VBA Bestimmen, Anschließend Berechnung von: BlackDevil
Geschrieben am: 10.09.2014 12:51:10

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


  

Betrifft: AW: Spalte mit VBA Bestimmen, Anschließend Berechnung von: BlackDevil
Geschrieben am: 10.09.2014 13:15:25

Kleine Änderung am Code die nix gebracht hat:

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



  

Betrifft: AW: Spalte mit VBA Bestimmen, Anschließend Berechnung von: BlackDevil
Geschrieben am: 10.09.2014 13:27:07

Ich glaube das Problem gefunden zu haben... wenn ich statt

Set srcRange = Worksheets(Models(i).ModelName).Range(Columns(srcCol).Column + 2 & ":" & Columns(srcCol).Column + 2)
diese Zeile verwende
Set srcRange = Worksheets(Models(i).ModelName).Range("40:40")
funktioniert das Makro. Erhöhe ich die Zahl langsam funktioniert das Makro bis ("49:49"). Bei "50:50" funktioniert es nicht mehr. Nicht mal beim allerersten Durchlauf. Insgesamt ist die Tabelle aber 130 Spalten breit, es existieren also Werte in der Spalte 50+.

Wo ist der Fehler bzw wie kann ich das beheben!?

Grüße


  

Betrifft: AW: Spalte mit VBA Bestimmen, Anschließend Berechnung von: BlackDevil
Geschrieben am: 10.09.2014 15:13:33

Nach längerem googlen und einem halben Kaffee später bin ich auf diese Website gestoßen: http://www.excel-training.de/makro_text_fr.asp?ID=272&Liste=makro_such_fr.asp&start=32&art=a

Ich habe die Funktion 1:1 implementiert und voilá - es geht. Man musste wie immer nur wissen wonach man suchen muss ... der Gesamte Code (an der Stelle) schaut nun so aus

' 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

Danke für die Kommentare :)


  

Betrifft: Die Forumssoftware stellt nur vollständige ... von: Luc:-?
Geschrieben am: 10.09.2014 04:12:29

…Prozeduren automatisch als PgmCode dar, BD,
d.h., sie reagiert auf die entsprd Begriffe in Kopf- u/o Fußzeile einer Prozedur und zwar immer auf Sub(-Prozedur → weshalb ich das jetzt so schreiben muss, um das zu verhindern) und auf die vollständige Fußzeile einer Function, wenn auch zuvor die entsprd Kopfzeile notiert wurde, was das Einbetten von HTML-Tabellen, die J[ava]Script enthalten, gestattet, ohne dass diese ebenfalls als PgmCode angesehen wdn.
Anderenfalls solltest du mal auf die Buttons direkt über dem Frage/AW-Formular achten! Jeder der 1. vier erzeugt das darauf angezeigte HTML-Tag-Paar. Weitere muss man b.Bed selber einfügen.
Deshalb kann man in Fmln (im PgmCode schon!) hier keine </>-Zeichen benutzen, sondern entweder die in den Forumshinweisen vorgeschlagenen speziellen Fml-Tags oder die benannten HTML-Codes dafür.
Morrn, Luc :-?


  

Betrifft: AW: Die Forumssoftware stellt nur vollständige ... von: BlackDevil
Geschrieben am: 10.09.2014 10:40:49

Danke für den Hinweis ;) Ich bin mir über das verwenden der Tags bewusst. Allerdings sehe ich gerade zum ersten mal den Tag für Code

Echo "Hallo Welt!"
Ist ja egal, das Forum ist neu für mich und verwendet nicht die Foren Standardsoftware. Da darf man doch etwas verwirrt sein :)

Mit der Range kam ich noch nicht weiter :/

Grüße


 

Beiträge aus den Excel-Beispielen zum Thema "Spalte mit VBA Bestimmen, Anschließend Berechnung"