Makro für 1681 Werte gesucht

Hallo alle zusammen,
ich habe eine Matrix, bei der sich durch verschiedene Kombinationen unterschiedliche Ergebnisse einstellen. Dafür sind zwei Felder vorgesehen. Die Kombinationsergebnisse sind manuell eingetragen. Problem: bei einer Erweiterung werden die Kombinationsergebnisse nicht aktualisiert. Es sind 1681 manuell eingetragene Werte, die sich in C3:AQ43 befinden. In der Zeile C2:AQ2 und in der Spalte B3:B43 befinden sich die Komponenten für die Berechnung. Die Berechnung befindet sich auf ein anderes Tabellenblatt. Kann man dies mit einen Makro lösen. Ich stelle mir das folgender Maßen vor: nehme den Wert von Matrixtabellenblatt C2 kopiere ihn und füge ihn in das Berechnungstabellenblatt T13 ein, nehme den Wert von Matrixtabellenblatt B3 kopiere ihn und füge ihn in das Berechnungstabellenblatt T17 ein, nehme das errechnete Ergebnis von Berechnungstabellenblatt von T18 füge den Wert ihn in die Matrix C3 ein. Dann den Wert von D2 und B3 nehmen in das Berechnungstabellenblatt einfügen den errechneten Wert in Matrixtabellenblatt D3 einfügen. Das alles müsste bis zur Zelle AQ 43 geschehen, dann muss eine Zelle tiefer gesprungen werden und die Kombinationsergebnisse von C2:AQ2 und B4 eingetragen werden in C4:AQ4, bei AQ4 wieder eine Zeile tiefer springen u.s.w. bis die Zelle AQ 43 erreicht ist, dann sollte das Makro beendet werden. In der angehängten Beispielsdatei sind noch einige Erläuterungen. Ich hoffe mir kann jemand helfen
Danke im Voraus!
Andre
https://www.herber.de/bbs/user/26515.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Luschi,
erstmal dank für deine mühe. mit deinen code bin ich fast 1 minute schneller. ich hatte mit 2 hilfsspalten mit den kombinationen aufgestellt (in AS und AT, AU=ausgabezelle) und folgenden code gebastelt.


Sub Makro1()
Application.ScreenUpdating = False
ActiveCell.Offset(0, -2).Range("A1").Select
Selection.Copy
Sheets("Berechnung").Select
Range("T13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Matrix").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Berechnung").Select
Range("T17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("T18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Matrix").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Range("A1").Select
If ActiveCell.Offset(1, 0) = "" Then
Makro1
End If
Range("AU2").Select
Application.ScreenUpdating = True
End Sub


Sub löschenundneuberechnen()
Sheets("Matrix").Range("AU2:AU1682").ClearContents
Range("AU2").Select
Makro1
End Sub

Mit dem code hat es ca.8 minuten gedauert. dank deiner hilfe erspare ich mir die formelerstellung für den bereich, dass auch mehr KB für die datei bedeutet hätte.
NOCHMALS VIELEN DANK !!!
Andre

wozu braucht man eigentlich eine solche Matrix? Wenn Du noch Fragen zum Programm-Code hast, dann kannst Du sie ruhig stellen. Die zentrale Zelle ist B2. In den For-Schleifen wird über ein Verschiebe-Index (OffSet(x, y)) die Zeile 2 und Spalte B durchlaufen, die Werte nach T13 und T17 kopiert und T18 in den Schittpunkt der beiden Achsen kopiert. Vielleicht läuft das Makro noch schneller, wenn Du am Anfang Application.Calculation = xlCalculationManual und am Ende Application.Calculation = xlCalculationAutomatic noch einfügst.

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread