Hallo Mwie Michie
**Ich danke dir für den VBA Code. Hat wunderbar funktioniert.
Anwenden kann ich es so aber noch nicht richtig.
Kommentare sind im Code. Ich hoffe ich habe an den richtigen
Stellen kommentiert,soweit ich es eben verstanden habe.
(Kommentare gelten immer den darüberstehenden Zeilen)**
Sub MengeTeilen()
’
'Variablen deklarieren
Dim BNameA As String 'Quellblatt Name
Dim ZMax As Long, ZMin As Long, ZeileA As Long 'Zeilen
Dim SMax As Integer, SMenge As Integer, SKlasse As Integer
'Spalten
Dim Menge As Integer, Klasse As Double, Merkmal As String
'Zellinhalte
’
Dim BNameB As String 'Zielblatt Name
Wie kann ich die Auswertung auf einem bestehenden
(definierten)oder dem selben Arbeitsblatt ausführen? Die
anschliessende statistische Auswertung soll auf dem Zielblatt
schon vorbereitet sein und einfach die Daten abfragen die über
das Makro eingetragen werden. Geht das? Man könnte die
Gesamtmenge begrenzen und ich könnte ab einer bestimmten Zeile
(z.B ab Zeile 800 die statistische Auswertung vorbereiten,
also Min, Max, Median, Quartil1, Quartil3 + Diagramme usw.)
Wenn Du darunter arbeitest, müsstest Du Dir sicher sein, dass die 800 Zeilen darüber ausreichen. Evtl. würde ich auf leere Spalten ausweichen.
Hier definiere ich nur den Namen des Containers der weiter unten dann mit dem Inhalt „Auswertung“ gefüllt wird. Wenn Du auf ein bestehendes Blatt zugreifen willst, entfiele der Block Sheets.Add, dazu weiter unten. Bei bestehenden Blättern muss die Zieladresse Cells(Zeile, Spalte) angepasst werden damit Du nicht bestehende Daten überschreibst. Oder anders. Wenn wir uns auf Dein Beispiel beziehen: hier stehen die Rohdaten auf Tabelle1. Wo genau sollen die Zieldaten hin?
Dim ZAus As Long, ZRiss As Long 'Zeilen
Dim SAus As Integer, SRiss As Integer 'Spalten
Dim I As Integer 'Zähler
’
'Variablen initialisieren
BNameA = ActiveWorkbook.ActiveSheet.Name 'Blattname
Quelldatensatz
SMenge = 2 'Spalte B
ZMin = 6 'Zeile ersten Datensatzes
Hier definiere ich die erste Zelle die abgefragt wird und dann
werden alle nach rechts und unten folgenden Zellen abgefragt?
Korrekt! Oben sehen wir die erste Spalte (SMenge) und erste Zeile (ZMin) des Datenbereiches.
Unten ermitteln wir per chicker Funktion die lezte Zeile des Datenbereiches (ZMax) sowie die letzte Spalte (SMax).
'Zellbereich für Werte ermitteln
With ActiveWorkbook.ActiveSheet
ZMax = Cells(1048576, SMenge).End(xlUp).Row 'Letze Zeile
SMax = ActiveWorkbook.ActiveSheet.UsedRange.Columns.Count
'Letzte Spalte
End With
’
BNameB = „Auswertung“ 'Blattname Zieldatensatz
wie oben schon erwähnt benötige ich ein bestehendes
Arbeitsblatt
Du könntest also einfach Auswertung in Anführungszeichen durch Deinen Zielblattnamen in Anführungszeichen ersetzen. Wenn dieses Blatt nicht leer ist, müssen wahrscheinlich die Zieladressen angepasst werden, siehe unten…
ZAus = 2
ZRiss = 2 'erste Zeile für Überschrift frei lassen
SAus = 2
SRiss = 4 'Spalte 2 und 4 verwenden
Es wird jetzt nur Prüfbereich 1 abgefragt und Aussprung und
Riss über das Makro ausgelesen. Was muss hier stehen damit
alle Prüfbereiche abgefragt werden? Es sind 36. In manchen
Prüfbereichen kommt zu „Aussprung“ und „Riss“ noch
„Oberfläche“ hinzu. (Das hangt davon ab ob der Prüfbereich
eine Kante oder eine Fläche ist. Bei Fläche kommt Prüfmerkmal
„Oberfläche“ hinzu) Ich hoffe das ist nicht zu kompliziert
erklärt. Es ist wohl doch etwas aufwändiger.
Bei einem weiteren Merkmal würden wir einfach eine Erweiterung der If Abfrage vornehmen, also nach
If Merkmal = „Ausssprung“ und
ElseIf Merkmal = „Riss“ zusätzlich
ElseIf Merkmal = „Oberfläche“ danach das obligatorische
End If
’
Application.ScreenUpdating = False 'Hinundherspringen
unterdrücken
’
Sheets.Add 'Neues Blatt einfügen
With ActiveWorkbook.ActiveSheet
.Cells(1, SAus).Value = „Aussprung“ 'Überschriften einfügen
.Cells(1, SRiss).Value = „Riss“
Überschriften sollen nicht eingefügt werden sondern die Daten
unter bestehende eingetragen werden
Wie oben bereits erwähnt würden hier diese vier Zeilen entfallen (oder einfach per ’ auskommentieren).
Das die Zieldaten unter bereits bestehende zu kopieren sind ist eine neue Option. Also, wie heisst das Zielblatt, und in welche Spalten sollen die Quelldaten kopiert werden?
Wer werden zwei weitere Parameter für Zeile und Spalte des Merkmals „Oberfläche“ benötigen. Wie oben werden wir dann für alle drei Spalten („Aussrpung“, „Riss“, „Oberfläche“) die letzte belegte Zeile ermitteln, um die neuen Daten darunter einzufügen.
.Name = BNameB 'umbenennen
.Move after:=Sheets(Sheets.Count) 'verschieben
End With
Sorry, auch diese drei Zeilen können wir entfernen, da wir bereits ein Zieldatenblatt haben.
’
Sheets(BNameA).Activate 'zurück zur Quelldatenblatt
With ActiveWorkbook.ActiveSheet
For SMenge = SMenge To SMax Step 2 'erste Schleife (Spalten)
SKlasse = SMenge + 1 'Spalte Klasse immer rechts neben Menge
Merkmal = Cells(4, SMenge).Value 'lesen ob "Aussprung oder
Riss
For ZeileA = ZMin To ZMax 'zweite Schleife (Zeilen)
Menge = Cells(ZeileA, SMenge).Value 'Werte lesen für Menge
Klasse = Cells(ZeileA, SKlasse).Value 'und Klasse
If Menge > 0 Then 'bei Menge Null keine Aktion
Sheets(BNameB).Activate 'sonst zum Zielblatt
Anstatt das BNameB zu erstellen und zu benennen werden wir oben per BNameB = „Blattname“ im Block Initialisierung einen festen Blattnamen vergeben.
With ActiveWorkbook.ActiveSheet
If Merkmal = „Aussprung“ Then 'Verzweigen
For I = 1 To Menge 'Eintrag wiederholen
Cells(ZAus, SAus).Value = Klasse
ZAus = ZAus + 1
Next
ZAus, ZRiss und ZOber müssen wir weiter oben erst einmal ermitteln.
ElseIf Merkmal = „Riss“ Then
For I = 1 To Menge
Cells(ZRiss, SRiss).Value = Klasse
ZRiss = ZRiss + 1
Next
Hier kommt die Abfrage für Oberfläche mit ElseIf… mit einem For To Next nach gleichem Muster.
End If
End With
Wie wird Ausprung und Riss vom Prüfbereich n abgefragt? (z.B.
Prüfbereich 12 oder Prüfbereich 23)
Das ist die zweite Schleife:
For SMenge = SMenge To SMax Step 2 'erste Schleife (Spalten)
SMenge ist die Spalte für die Menge, die bei 2 beginnt (Initialisierung) und bei SMax (letzte Spalte in Deiner Matrix endet. Der Step 2 bewirkt, dass wir nur jede zweite Spalte verwenden, da ja direkt neben der Menge die Klasse steht.
Oder wolltest Du einzelne Spalten direkt ansteuern? Dann wären wir mit der Schleife (zumindest mit dieser) auf dem falschen Pfad.
Sheets(BNameA).Activate 'zurück zum Quelldatenblatt
End If
Next 'nächste Zeile lesen
Next 'zur nächsten Spalte (Abstand 2: Menge und Klasse!)
End With
Application.ScreenUpdating = True
End Sub
Bitte ausprobieren. Wenn es Probleme gibt, meld Dich noch mal.
Das Makro funktioniert sehr gut. Sehr gute Beschreibung.
Und wenn es keine gibt, würd’ ich mich auch über eine
Rückmeldung freuen.
kannst du mir bei den bestehenden Problemem bitte noch helfen?
Ich glaube alleine bekomme ich den Code nicht angepasst.
Gib mir einfach Bescheid wie das Zieldatenblatt benannt ist, und in welcher Spalte die Einträge für „Aussprung“, „Riss“ und „Oberfläche“ unterzubringen sind. Ich kann Dir das Makro dann anpassen.
Wenn Du einzelne Spalten ansteuern möchtest, müsst ich mir ggf. noch mal Gedanken machen. Aber auch das sollte lösbar sein.
Grusse aus der Schweiz,
Comander001
MfG MwieMichel
