Herbers Excel-Forum - das Archiv

Makro

  • Makro von Claudia vom 19.12.2006 10:33:53
Bild

Betrifft: Makro
von: Claudia

Geschrieben am: 19.12.2006 10:33:53
Guten MOrgen,
ich habe folgendes Problem: Ich muss einige Datenblätter ziemlich ähnlich bearbeiten. Nur die Größe der Tabelle ist immer unterschiedlich.
Ich habe versucht das ganze mittel Makrorecorder aufzunehmen, bin daran aber nur verzweifelt weil es einfach nicht das macht was ich will.
Deshalb meine Bitte an Euch: Wer kann das?
Die Registerblätter B1-LM4-05, B1-LM4-10 und LM4-20 sind noch nicht bearbeitete Tabellen. B1-LM3-30 ist die "nachher" Version.
Wäre super wenn sich da jemand auskennt und mir helfen könnte!
Folgende Arbeitsschritte habe ich der Reihenfolge gemacht:
- 2 Leerzeilen nach jeder "Datei" einfügen. B1-1-xxxx wurde in verschiedene Unterdateien getrennt. Wenn die Datei ursprünglich 15 Wörter hatte, dann wurde es im Registerblatt B1-LM4-05 auf 3 Dateien aufgeteilt, da pro "Unterdatei" nur 5 Wörter sind.
- für jede Datei das Maximum pro Spalte berechnen
- Die Summe der Maximums wird durch die Anzahl dividiert
- Mittels SVerweis wird die Note (Registerblatt Grenzen) ermittelt.
- Spalte B bis D werden dahinter nochmals eingefügt (nur Werte) wobei für jede Datei die Noten nur einmal dortstehen
- Die Korrelation zwischen Note Computer und den ursprünglichen Noten wird berechnet (3 Versionen)
- die exakte und angrenzende Übereinstimmung wird berechnet (zwei mal drei versionen.
Fertig...
Hier die Datei: https://www.herber.de/bbs/user/39103.xls
Sollte nur ein Teil der Aufgaben mittels Makros erledigt werden können - ich bin auch damit schon selig...
DANKE! und lg aus Wien...
Claudia
Bild

Betrifft: AW: Makro
von: fcs

Geschrieben am: 19.12.2006 16:24:33
Hallo Claudia,
nach etwas Tüftelarbeit zum generieren der Formeln sollte folgendes Makro die gewünschten Operationen durchführen.
Das Makro arbeitet immer das gerade aktive Blatt ab. Die Tabelle wird dabei von unten nach oben abgearbeitet. Die im Makro in Amerikanischer Schreibweise generierten Formeln werden dabei automatisch in die im Tabellenblatt verwendete Sprache umgesetzt.
Gruß
Franz
Sub BlattAufbereiten()
Dim wks As Worksheet
Dim ZeileFormel As Long, Zeile As Long, ZeileA As Long, ZeileE As Long
Dim Spalte1 As Integer, SpalteL As Integer
Set wks = ActiveSheet
With wks
'Nächste freie Zeile in Spalte A
ZeileFormel = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
'1. Spalte für die Max-Wert berechent werden soll
Spalte1 = 5
'Letzte Datenspalte für die Max-Wert berechent werden soll
SpalteL = .Cells(1, .Columns.Count).End(xlToLeft).Column
'Titelzeile auffüllen
.Cells(1, SpalteL + 1) = "Summe"
.Cells(1, SpalteL + 2) = "Note Computer"
.Cells(1, SpalteL + 3) = "1. Korrektur"
.Cells(1, SpalteL + 4) = "2. Korrektur"
.Cells(1, SpalteL + 5) = "wahre Note"
.Cells(1, SpalteL + 7) = "exakte Ü - K1"
.Cells(1, SpalteL + 8) = "exakte Ü - K2"
.Cells(1, SpalteL + 9) = "exakte Ü - wahre N"
' exakte Ü - K2 exakte Ü - wahre N
Do Until Zeile = 1
'2 Leerzeilen einfügen
.Range(.Rows(ZeileFormel), .Rows(ZeileFormel + 1)).Insert
ZeileE = ZeileFormel - 1 'End-Zeile für Max-Formel
Zeile = ZeileE
'Anfangszeile der Datei suchen
Do Until Right(.Cells(Zeile, "A").Value, 5) = "1.txt" Or Zeile = 2
Zeile = Zeile - 1
Loop
ZeileA = Zeile 'Anfangs-Zeile für Max-Formel
'Max-Formeln einfügen
For Spalte = Spalte1 To SpalteL
.Cells(ZeileFormel, Spalte).FormulaR1C1 = "=MAX(R[" & -(ZeileE - ZeileA + 1) & "]C[]:R[" & -1 & "]C[])"
Next
'Formel für Durchschnitt Maxwerte einfügen
.Cells(ZeileFormel, SpalteL + 1).FormulaR1C1 = "=SUM(R[]C[" & -(SpalteL - Spalte1 + 1) & "]:R[]C[" & -1 & _
"])/COUNTA(R[]C[" & -(SpalteL - Spalte1 + 1) & "]:R[]C[" & -1 & "])"
'Formel für Note einfügen
.Cells(ZeileFormel, SpalteL + 2).FormulaR1C1 = _
"=LOOKUP(R[]C[" & -1 & "],'Grenzen'!R4C2:R9C2,'Grenzen'!R4C3:R9C3)"
'Werte aus Spalten B bis D kopieren
.Cells(ZeileFormel, SpalteL + 3).Range("A1:C1").Value = .Cells(ZeileE, 2).Range("A1:C1").Value
'Formel exakte Ü - K1
.Cells(ZeileFormel, SpalteL + 7).FormulaR1C1 = _
"=IF(R[]C[" & -4 & "]=R[]C" & SpalteL + 2 & ",1,0)"
'Formel exakte Ü - K2
.Cells(ZeileFormel, SpalteL + 8).FormulaR1C1 = _
"=IF(R[]C[" & -4 & "]=R[]C" & SpalteL + 2 & ",1,0)"
'Formel exakte Ü - wahre N
.Cells(ZeileFormel, SpalteL + 9).FormulaR1C1 = _
"=IF(R[]C[" & -4 & "]=R[]C" & SpalteL + 2 & ",1,0)"
ZeileFormel = ZeileA
Zeile = Zeile - 1
Loop
End With
End Sub

 Bild