ich benötige bitte eure Hilfe und hoffe, dass meine erste Problemschilderung nicht zu unverständlich ist.
Hier mein Problem bzw. Wunsch-Makro:
Farblich markierte Zellen in Tabelle1: C1: =3453,63+235,64-23563,12
D5: =1234,43-234+234.... usw.
Aufteilung der farblich markierten Zelleninhalte von Tabelle1 in Tabelle2:
Tabelle 2: C1: 3453,63 D2: 235,64 E3: -23563,12 usw.
Batchliste in Tabelle 3:
A1: 3453,63 .......... B1: 123,45
A2: 235,64 .............. B2: 567,87
A3: -23563,12 .......... B3: -345,54 usw.
Und das Ergebnis nach dem Wunsch Makro in Tabelle1 sollte wie folgt aussehen:
Tabelle1: C1: =123,45+567,87-345,54
(Problem: es sollten nur die farblich markierten Zellen ersetzte werden, dh es kann auch forkommen, dass Zellen in Tabellenblatt 1 die gleichen Werte aufweisen, daher derzeit noch händisch kopiert)
So würde ich mir das Ergebnis des Makros vorstellen.
Derzeitiger Stand meiner Makros:
Makro zur Erstellung einer Liste von den farblich markierten Zellen in Tabelle1 in Tabelle2:
Public Sub Werte_auslesen()
Dim rngzelle As Range
Dim lngZeile As Long
lngZeile = 1
With Worksheets("Tabelle2") 'Hier Name des Zielblattes anpassn
For Each rngzelle In ActiveSheet.Range("A1:H2600") 'Suchbereich anpassen
If rngzelle.Interior.ColorIndex = 10 Then
rngzelle.Copy .Cells(lngZeile, 1)
lngZeile = lngZeile + 1
End If
Next rngzelle
.Range("A:A").Sort Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlNo
End With
End Sub
Tabelle 2:
Anschließend soll der Zelleninhalt (A1) auf Spalten aufteilt werden.
Derzeit ist noch das ganze Tabellenblatt verformelt:
zB: Z1: =WENN(ISTFEHLER(formeltrennen(A1;1));"";formeltrennen(A1;1))
AA1 =WENN(ISTFEHLER(formeltrennen(A1;2));"";formeltrennen(A1;2))
das dazugehörige Modul lautet wie folgt:
Option Explicit
Public Function formeltrennen(zelle, zahl As Integer)
Dim operator()
Dim operatorersetz()
Dim formel As String
Dim zahlen
Dim dummy
Dim i As Integer
operator = Array("=", "+", "-", "*", "\", "/", "(", ")")
operatorersetz = Array("", "##", "##-", "##", "##", "##", "", "")
dummy = zelle.FormulaLocal
For i = 0 To UBound(operator)
dummy = Replace(dummy, operator(i), operatorersetz(i))
Next
zahlen = Split(dummy, "##")
formeltrennen = zahlen(zahl)
End Function
Diese aufgeteilten Zelleninhalte werden in weiterer folge durch aktuelle Werte aus einer weiteren Tabelle ersetzt:
BB1: =WENN(ISTFEHLER(SVERWEIS(Z1;Tabelle3!$A$1:$B$2000;2;FALSCH));"";SVERWEIS(Z1;Tabelle3!$A$1:$B$2000;2;FALSCH))
Dies habe ich derzeit mit einem Sverweis gelöst. Das Problem ist, dass die aus dem Modul ausgegebenen Zahlen (anscheinend Text) nicht mit dem Sverweis funktionieren (Zahlen). Daher habe ich es mit inhalte einfügen gelöst. Das hat auch funktioniert, hat aber mein verformeltes Sheet zerstört.
In weiterer folge habe ich diese Zahlen wieder in eine Zelle zusammengefügt
CC1: =z1&"+"&Z2&...... (die unnötigen ++++ bzw. +- mit suchen ersetzen gelöscht)
und derzeit noch händisch in die Tabell1 übertragen.
In weiterer Folge soll dies mit folgenden Makro in die Ursprungsdatei eingefügt werden.
Sub daten_uebertragen()
Dim verg(5000), ktoneu(5000)
Dim z%, r%, s%
Worksheets("Tabelle2").Activate
z = 1
Do While Cells(z, 1) ""
verg(z) = Cells(z, 1)
ktoneu(z) = Cells(z, 2)
z = z + 1
Loop
Worksheets("Tabelle1").Activate
For r = 2 To z - 1
For s = 2 To z - 1
If Cells(r, 3) = verg(s) Then Cells(r, 3) = ktoneu(s)
Next s
Next r
End Sub
Derzeit versuche ich dieses Makro so anzupassen, dass es die geänderten Zellen nur in die farblich markierten Zellen des Tabellenblatts 1 einfügt.
Da ich die einzelnen Makros bzw. die noch nicht automatisierten Schritte und das Modul nicht zu einem Makro zusammenfügen kann, hoffe ich auf eure Unterstützung.
LG
Ratio