Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
828to832
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
828to832
828to832
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro

Makro
19.12.2006 10:33:53
Claudia
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro
19.12.2006 16:24:33
fcs
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige