Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1652to1656
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
Inhaltsverzeichnis

Formel in Makro wandeln

Formel in Makro wandeln
25.10.2018 17:21:12
michael
Brauche wieder einmal Hilfe
Wie kann ich die folgende Formel in ein Makro wandeln?
=WENN(Liste2!B3>0;VERWEIS(Liste2!A3;Bestand!G:G;Bestand!B:B);"")~f~
Und zwar so, dass das Makro automatisch in "Liste2" nach Einträgen sucht, und diese dann untereinander, laut VERWEIS, auflistet.
In Liste2 stehen in Spalte A Nummern untereinander, In Spalte B befinden sich unregelmäßige Einträge. Oft sind die Zellen leer.
Meine Formel schaut in "Liste2" nach ob in Zelle B3 ein Eintrag vorhanden ist, wenn dort eine Zahl (größer als 0) steht, sucht die Formel dann anhand der Nummer in Zelle A3, den Entsprechenden Eintrag in der Liste "Bestand", und gibt den entsprechenden Text an (z.B. Kartoffeln).
In meiner Tabelle3 habe ich nun viele Formeln untereinander stehen.
~f~
=WENN(Liste2!B3>0;VERWEIS(Liste2!A3;Bestand!G:G;Bestand!B:B);"")
=WENN(Liste2!B4>0;VERWEIS(Liste2!A4;Bestand!G:G;Bestand!B:B);"")
=WENN(Liste2!B5>0;VERWEIS(Liste2!A5;Bestand!G:G;Bestand!B:B);"")
=WENN(Liste2!B6>0;VERWEIS(Liste2!A6;Bestand!G:G;Bestand!B:B);"")
=WENN(Liste2!B7>0;VERWEIS(Liste2!A7;Bestand!G:G;Bestand!B:B);"")
=WENN(Liste2!B8>0;VERWEIS(Liste2!A8;Bestand!G:G;Bestand!B:B);"")
=WENN(Liste2!B9>0;VERWEIS(Liste2!A9;Bestand!G:G;Bestand!B:B);"")
Usw....
Das erzeugt natürlich eine Menge Leerfelder, wenn kein Eintrag da ist.
Ziel soll sein, dass das Makro Spalte B, ab Zeile 3 bis Listenende(ca.600) durchläuft, und jedes Mal wenn ein Eintrag da ist, die entsprechenden Verweise Lückenlos untereinander auflistet.
Vielen Dank für eure Hilfe
Michael

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Formel in Makro wandeln
25.10.2018 17:29:24
onur
Beispieldatei posten , ich mache mir nicht die Arbeit, das für dich zu erledigen, damit ich dir helfen und auch den code testen kann.
AW: Beispieldatei
26.10.2018 15:54:37
Piet
Hallo Michael
hier ein erster Lösungversuch von mir, konnte keine Beispieldatei hochladen, dafür der Code.
Neben Preis ist die Spalte als Datum formatiert, nicht als Zahl für den Preis!!
Probier mal aus ob meine Auflistung wie gewünscht klappt? Ein Problem könnte die Artikel Nummer sein, wenn sie in Liste2 mit "002" steht, aber im Bestand als Zahl 2 angegeben ist. Warten wir ab ...
mfg Piet
Option Explicit
Const Ziel = "Tabelle3 Ziel"
'Listet Bestand nach Liste2 in Ziel-Tabelle3 auf.
Sub Bestand_inTabelle3_auflisten()
Dim AC As Range, rfind As Range, z As Long
Dim Li2 As Worksheet, lzLi2 As Long
Dim Bst As Worksheet, lzBst As Long
Set Li2 = Worksheets("Liste2")
Set Bst = Worksheets("Bestand")
'LastZell in:  Liste2 + Bestand suchen
lzLi2 = Li2.Cells(Rows.Count, 1).End(xlUp).Row
lzBst = Bst.Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets(Ziel)
'alte Ziel Tabelle3 löschen
.UsedRange.Offset(1, 0).ClearContents
z = 4 '1. Zeile in Ziel-Tabelle
For Each AC In Li2.Range("A2:A" & lzLi2)
If AC.Cells(1, 2).Value  "" Then
Set rfind = Bst.Columns("G").Find(What:=AC, After:=Range("G1"), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not rfind Is Nothing Then
Bst.Cells(rfind.Row, 2).Resize(1, 6).Copy .Cells(z, 1)
z = z + 1   'Next Zeile in Tabelle3
Else
MsgBox AC & "  nicht in Bestand gefunden!"
End If
End If
Next AC
End With
End Sub

Anzeige
Hallo Piet
26.10.2018 19:04:20
Michael
Hallo Piet
Dein Code klappt perfekt, sogar umfangreicher als erfragt. Super gemacht.
Da dein Code umfangreicher ist als erwartet, benötige ich aber noch eine weitere Hilfe.
Deinen Code habe ich geringfügig geändert, so das jetzt auch noch 2 neue Spalten in "Bestand" erfasst werden. Meine Frage: wie kann ich den Code so abändern das das Ergebnis in anderer Reihenfolge aufgeführt wird. Manche Spalten benötige ich nicht, dafür eine aus "Liste2"?
Habe eine neue Beispieldatei hochgeladen, mit deinem Code und einem Command Button in Liste2, um ihn zu Testen. In einem neuen Reiter (wusch ziel) habe ich die gewünschte Reihenfolge und ein paar "Feinheiten" aufgeführt. Hoffe das sie sich verwirklichen lassen.
https://www.herber.de/bbs/user/124933.xlsm
Vielen herzlichen Dank
Michael
Anzeige
AW: Formel in Makro wandeln
26.10.2018 22:08:33
Piet
Hallo
ich habe das Makro umgeschrieben, (neuer Name). Bitte die Daten noch mal auf Richtigkeit prüfen.
Ich setze voraus das in Zeile 4 immer eine gültige Formel steht, kopiere sie fortlaufend nach unten.
mfg Piet
Option Explicit
Const Ziel = "wunsch ziel"
'Listet Bestand nach Liste2 in Tabelle "Wunsch-Ziel" auf.
Sub Bestand_inWunschZiel_auflisten()
Dim AC As Range, rfind As Range, z As Long
Dim Li2 As Worksheet, lzLi2 As Long
Dim Bst As Worksheet, lzBst As Long
Set Li2 = Worksheets("Liste2")
Set Bst = Worksheets("Bestand")
'LastZell in:  Liste2 + Bestand suchen
lzLi2 = Li2.Cells(Rows.Count, 1).End(xlUp).Row
lzBst = Bst.Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets(Ziel)
'alte Wunsch-Ziel Tabelle löschen
.UsedRange.Offset(4, 0).ClearContents
z = 4 '1. Zeile in Wunsch-Ziel Tabelle
For Each AC In Li2.Range("A2:A" & lzLi2)
If AC.Cells(1, 2).Value  "" Then
Set rfind = Bst.Columns("G").Find(What:=AC, After:=Range("G1"), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not rfind Is Nothing Then
'Formel 1 Zeile nach unten kopieren
If z > 4 Then .Cells(z - 1, 5).Resize(1, 5).Copy .Cells(z, 5)
.Cells(z, 1) = Bst.Cells(rfind.Row, 2)    'Bestand Spalte B
.Cells(z, 2) = AC.Cells(1, 2)             'Liste2  Spalte B
.Cells(z, 3) = "x"                        '"x" als Text
.Cells(z, 4) = Bst.Cells(rfind.Row, 4)    'Bestand Spalte D
.Cells(z, 6) = Bst.Cells(rfind.Row, 5)    'Bestand Spalte E
.Cells(z, 8) = Bst.Cells(rfind.Row, 9)    'Bestand Spalte I
.Cells(z, 10) = Bst.Cells(rfind.Row, 7)   'Bestand Spalte G
z = z + 1   'Next Zeile in Tabelle3
Else
MsgBox AC & "  nicht in Bestand gefunden!"
End If
End If
Next AC
End With
End Sub

Anzeige
Hallo Piet
27.10.2018 21:40:01
Michael
Hallo Piet
Dein Code läuft Prima, einfach super.
Es gibt nur einen kleinen Schönheitsfehler, den ich noch irgendwie beheben muss. In meiner Original Tabelle "wunsch ziel" stehen in Zeile 4, keine Formeln, auch gibt es die ersten 3 Zeilen nicht. Im Original ist die Tabelle "wunsh ziel" nur eine leere Seite die in Zeile 1 anfängt, und die erst durch deinen und anderen Code gefüllt wird.
Habe versucht die Formeln im Blattcode zu hinterlegen, bin daran aber kläglich gescheitert.
Gibt es die Möglichkeit die 3 Formeln in "Liste2" Zeile 1 zu hinterlegen. Diese Zeile ist leer. Nur wie sage ich deinem Code wo er die Formeln findet.
Oder geht doch die Variante mit dem Blattcode? Wie müsste das geschrieben werden?
Können die Formeln nicht im Code selbst eingebettet sein?
Vielen Dank für deine Hilfe
Michael
Anzeige
Hallo Piet
29.10.2018 19:34:51
Michael
Hallo Piet
Habe deinen Code noch etwas erweitert. Leider funktioniert er nun nicht mehr komplett.
Option Explicit
Const Ziel = "wunsch ziel2"
'Listet Bestand nach Liste2 in Tabelle "Wunsch-Ziel" auf.
Sub Bestand_inWunschZiel_auflisten()
Dim AC As Range, rfind As Range, z As Long
Dim Li2 As Worksheet, lzLi2 As Long
Dim Bst As Worksheet, lzBst As Long
Set Li2 = Worksheets("Liste2")
Set Bst = Worksheets("Bestand")
'LastZell in:  Liste2 + Bestand suchen
lzLi2 = Li2.Cells(Rows.Count, 1).End(xlUp).Row
lzBst = Bst.Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets(Ziel)
'alte Wunsch-Ziel Tabelle löschen
.UsedRange.Offset(49, 0).ClearContents
Range("E49").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-3]"
Range("H49").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-3]"
Range("I49").Select
ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-4]"
Range("K49").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-6]"
z = 49 '1. Zeile in Wunsch-Ziel Tabelle
For Each AC In Li2.Range("A2:A" & lzLi2)
If AC.Cells(1, 2).Value  "" Then
Set rfind = Bst.Columns("G").Find(What:=AC, After:=Range("G1"), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not rfind Is Nothing Then
'Formel 1 Zeile nach unten kopieren
'If z > 49 Then .Cells(z - 1, 5).Resize(1, 5).Copy .Cells(z, 5)
.Cells(z, 1) = Bst.Cells(rfind.Row, 2)    'Bestand Spalte B
.Cells(z, 2) = AC.Cells(1, 2)             'Liste2  Spalte B
.Cells(z, 3) = "x"                        '"x" als Text
.Cells(z, 4) = Bst.Cells(rfind.Row, 4)    'Bestand Spalte D
.Cells(z, 7) = Bst.Cells(rfind.Row, 5)    'Bestand Spalte E
.Cells(z, 10) = Bst.Cells(rfind.Row, 9)   'Bestand Spalte I
.Cells(z, 12) = Bst.Cells(rfind.Row, 8)   'Bestand Spalte H
.Cells(z, 13) = Bst.Cells(rfind.Row, 7)   'Bestand Spalte G
z = z + 1   'Next Zeile in Tabelle3
Else
MsgBox AC & "  nicht in Bestand gefunden!"
End If
End If
Next AC
End With
End Sub
Alle 4 Formeln werden jetzt wie beabsichtigt vom Makro eingetragen, aber nur die ersten 3 werden runterkopiert. Die vierte Formel wird nach dem Eintrag in die Tabelle ignoriert. Kannst du mir sagen an welcher Stelle der Fehler liegt?
Noch schöner wäre es, wenn anstelle der Formeln, nur deren Ergebnis als Wert eingetragen würde.
Vielen Dank
Michael
Anzeige
AW: Hallo Piet
30.10.2018 14:33:10
Piet
Hallo Michael
einen Teil konnte ich verstehen und das Makro korrigieren. Die im Code mit "#" markierten Zeilen bitte selbst prüfen!
Bei "wunsch ziel2" hast du 2 Spalten neu eiğngefügt. Dadurch stimmt wahrscheinlich mein Spalten Index nicht mehr!!
Leider fehlt mir die Überschrift welcher Wert aus welcher Bestand Spalte in welche "wunsch ziel2" Spalte geladen werden muss?
Diese Spaltenangabe, z.b. .Cells(z, 4) = Bst.Cells(rfind.Row, 4) 'Bestand Spalte D nach "wunsch ziel2" Spalte 4 muss überprüft und korrigiert werden. Dann sollte es klappen. Da habe ich aber nicht richtig durchgebkickt wie es jetzt sein soll?
Die Formel klappt auch ohne Select! Ich vermute das die Formel in Zelle "H49" nach "G49" gehört. Ist das richtig?
mfg Piet
   '1. Formel setzen
.Range("E49").FormulaR1C1 = "=RC[-1]*RC[-3]"
.Range("H49").FormulaR1C1 = "=RC[-1]*RC[-3]"   '##  Spalte G ?
.Range("I49").FormulaR1C1 = "=RC[-2]*RC[-4]"
.Range("K49").FormulaR1C1 = "=RC[-1]*RC[-6]"
z = 50 '1. Zeile in Wunsch-Ziel Tabelle
For Each AC In Li2.Range("A2:A" & lzLi2)
If AC.Cells(1, 2).Value  "" Then
Set rfind = Bst.Columns("G").Find(What:=AC, After:=Range("G1"), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not rfind Is Nothing Then
'Formel 1 Zeile nach unten kopieren
.Cells(z - 1, 5).Resize(1, 7).Copy .Cells(z, 5)
'## in dieser Liste ist ein Verdreher!!
'## wunsch ziel2 wurde um  2 Spalten erweitert!!
'## Bitte bei .Cells(z, 1) = die Spalten Indexe überprüfen!!
.Cells(z, 1) = Bst.Cells(rfind.Row, 2)    'Bestand Spalte B
.Cells(z, 2) = AC.Cells(1, 2)             'Liste2  Spalte B
.Cells(z, 3) = "x"                        '"x" als Text
.Cells(z, 4) = Bst.Cells(rfind.Row, 4)    'Bestand Spalte D
.Cells(z, 8) = Bst.Cells(rfind.Row, 5)    'Bestand Spalte F
.Cells(z, 10) = Bst.Cells(rfind.Row, 9)   'Bestand Spalte I
.Cells(z, 12) = Bst.Cells(rfind.Row, 8)   'Bestand Spalte H
.Cells(z, 13) = Bst.Cells(rfind.Row, 7)   'Bestand Spalte G
z = z + 1   'Next Zeile in Tabelle3
Else
MsgBox AC & "  nicht in Bestand gefunden!"
End If
End If
Next AC

Anzeige
AW: Hallo Piet
30.10.2018 16:21:36
michael
Hallo Piet
Die von mir etwas umgestaltete Wiedergabe der Spalten ist für meine Anforderungen korrekt.
Aussehen "wunsch ziel_2"
Spalte "A" = Bestand Spalte B (Name)
Spalte "B" = Liste2 Spalte B (Menge)
Spalte "C" = "x"
Spalte "D" = Bestand Spalte D (Inhalt)
Spalte "E" = FormulaR1C1 = "=RC[-1]*RC[-3]" (Stückzahl D*B)
Spalte "F" = leer
Spalte "G" = Bestand Spalte E (Preis_1)
Spalte "H" = FormulaR1C1 = "=RC[-1]*RC[-3]" (Preis_1*Stückzahl) (G*E)
Ab Spalte "I" ist die Tabelle für andere nicht mehr relevant und Angaben darin, dienen ausschließlich zur Auswertung.
Spalte "I" = FormulaR1C1 = "=RC[-2]*RC[-4]" (Identisch mit Spalte H) (G*E)
Spalte "J" = Bestand Spalte I (Preis_2)
Spalte "K" = FormulaR1C1 = "=RC[-1]*RC[-6]" (Preis_2*Stückzahl) (J*E)
Spalte "L" = Bestand Spalte H (Kürzel Warengruppe) wird zur Auswertung benötigt
Spalte "M" = Bestand Spalte G (Artikelnummer)
Hier der abgeänderte Code, klappt jetzt einwandfrei!!!
Option Explicit
Const Ziel = "wunsch ziel2"
'Listet Bestand nach Liste2 in Tabelle "Wunsch-Ziel2" auf.
Sub Bestand_inWunschZiel2_auflisten()
Dim AC As Range, rfind As Range, z As Long
Dim Li2 As Worksheet, lzLi2 As Long
Dim Bst As Worksheet, lzBst As Long
Set Li2 = Worksheets("Liste2")
Set Bst = Worksheets("Bestand")
'LastZell in:  Liste2 + Bestand suchen
lzLi2 = Li2.Cells(Rows.Count, 1).End(xlUp).Row
lzBst = Bst.Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets(Ziel)
'alte Wunsch-Ziel Tabelle löschen
.UsedRange.Offset(49, 0).ClearContents
.Range("E49").FormulaR1C1 = "=RC[-1]*RC[-3]"
.Range("H49").FormulaR1C1 = "=RC[-1]*RC[-3]"
.Range("I49").FormulaR1C1 = "=RC[-2]*RC[-4]"
.Range("K49").FormulaR1C1 = "=RC[-1]*RC[-6]"
z = 49 '1. Zeile in Wunsch-Ziel Tabelle
For Each AC In Li2.Range("A2:A" & lzLi2)
If AC.Cells(1, 2).Value  "" Then
Set rfind = Bst.Columns("G").Find(What:=AC, After:=Range("G1"), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not rfind Is Nothing Then
'Formel 1 Zeile nach unten kopieren
If z > 49 Then .Cells(z - 1, 5).Resize(1, 7).Copy .Cells(z, 5)
.Cells(z, 1) = Bst.Cells(rfind.Row, 2)    'Bestand Spalte B
.Cells(z, 2) = AC.Cells(1, 2)             'Liste2  Spalte B
.Cells(z, 3) = "x"                        '"x" als Text
.Cells(z, 4) = Bst.Cells(rfind.Row, 4)    'Bestand Spalte D
.Cells(z, 7) = Bst.Cells(rfind.Row, 5)    'Bestand Spalte E
.Cells(z, 10) = Bst.Cells(rfind.Row, 9)   'Bestand Spalte I
.Cells(z, 12) = Bst.Cells(rfind.Row, 8)   'Bestand Spalte H
.Cells(z, 13) = Bst.Cells(rfind.Row, 7)   'Bestand Spalte G
z = z + 1   'Next Zeile in Tabelle3
Else
MsgBox AC & "  nicht in Bestand gefunden!"
End If
End If
Next AC
End With
End Sub
Vielen Dank für deine Hilfe. Dein Code erspart mir 17 Tabellen mit insgesamt 90168 Formeln
Viele Grüße und nochmals vielen Dank!
Michael
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige