Marko Formel - Verweis - ändern in ein Makro

Question

Hallo zusammen,

leider bin ich noch ein Neuling, wenn es um Makros geht. Eine 3tägige Schulung hatte ich bereits. Aber ihr wißt es besser: dafür brauch man viel Zeit.

Hier meine Formel, die auch gut funktioniert.
Leider fängt die Tabelle bei jeder Eingabe an zu rechnen. Das ist aber nur einmalig bei einer Änderung nötig.

VERWEIS(2;1/(Tabelle2!$A:$A&Tabelle2!$B:$B=$A3&B$1);Tabelle2!$C:$C)


Ich versuch es mal zu erklären: Hoffe mein "Bild" bleibt für euch visuell richtig stehen

Tabelle1 Tabelle2

(A) (B) (C) (A) (B) (C)

(1) 3D0 3D5 123 3D5 50
(2) 123 ?=50 789 3D0 60
(3) 456 ?=80 321 3D0 70
(4) 789 ?=60 456 3D5 80
(5) 321 ?=70

Gesucht = ?
Lösung = Tabelle 2 Spalte C
Gesucht in Tabelle1 C2 = Lösung Tabelle2 C1

Und wenn es mit Tabelle1 SpalteB fertig ist, dann in die nächste Spalte wechseln bis in Zeile (1) in einer Zelle nichts mehr steht.

Wäre toll wenn ihr mir helfen könntet

Gruß
In Tabelle 1 soll in Spalte C

Answer 1

Hi,

Wie Du selbst siehst, geht das "TabellenFormat" hier so völlig verloren. Und zumindest ich kann so nicht zuordnen was wo wann berechnet wird/werden soll. (Das kann sich bei den ExcelSpezialisten hier im Forum nat. ganz anders verhalten.) Dennoch wäre es evtl. einfacher, wenn Du Dein Beispiel einmal in ein ExcelFile schreibst, und es z.B. bei www.file-upload.net/ hochlädst. Nach dem Upload erhälst Du dort einen Downloadlink, den Du dann hier zum Besten geben kannst.

bye
malSchauen

Answer 2

Hallo malSchauen,

danke für den Tip mit der Internetseite.
Hoffe er funktioniert, da ich das noch nie gemacht habe.
Sollte wieder etwas nicht stimmen, dann bitte melden

Hier ist er.

http://www.file-upload.net/download-1944436/Formel_in_Makro.xls.html

Gruß

Answer 3

Hi,

Das hat wunderbar funktioniert mit der Datei. Ich muss gestehen, ich habe keine Ahnung von solchen Formeln. Aber genau so hatte ich mir das zusammengereimt. Und folgendes Makro sollte zu eben diesem Ergebnis führen.

Sub VerweisAlsMakro()
'Variablendeklaration
'====================
Dim lngQR As Long, lngQC As Long
Dim lngVR As Long, lngVLR As Long
Dim lngQLR As Long, lngQLC As Long
Dim varScratchR As Variant, varScratchC As Variant
Dim shQuel As Worksheet, shVerw As Worksheet

Set shQuel = ThisWorkbook.Sheets("Tabelle1") 'Tabelle1 als Quelle
Set shVerw = ThisWorkbook.Sheets("Tabelle2") 'Tabelle2 als Verweisliste

'Werte im Ergebnisbereich löschen
shQuel.Range("B2:" & shQuel.Cells.SpecialCells(xlCellTypeLastCell).Address).Clear

lngQLR = shQuel.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Reihe in der Quelle
lngQLC = shQuel.Cells(1, Columns.Count).End(xlToLeft).Column 'letzte Spalte in Quelle
lngVLR = shVerw.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Reihe in Verweis

For lngQR = 2 To lngQLR Step 1 'für jede QuellReihe bis Letzte
For lngQC = 2 To lngQLC Step 1 'für jede QuellSpalte bis Letzte
varScratchR = shQuel.Cells(lngQR, 1).Value 'Wert A-Reihe zwischenspeichern
varScratchC = shQuel.Cells(1, lngQC).Value 'Wert Spalte-1 zwischenspeichern
For lngVR = 1 To lngVLR Step 1 'für jede Reihe in Verweis
If shVerw.Cells(lngVR, 1).Value = varScratchR And _
shVerw.Cells(lngVR, 2).Value = varScratchC Then 'Wenn Übereinstimmung
shQuel.Cells(lngQR, lngQC).Value = shVerw.Cells(lngVR, 3).Value 'Ergebnis eintragen
End If
Next
Next
Next
End Sub

Kopiere dieses Makro in ein StandardModul und starte es über eine Befehlsschaltfläche oder über eine Tastenkombination.

bye
malSchauen

Answer 4

Hallo mischi,

Deine Formel müsste so geändert werden

=WENN(ISTNV(VERWEIS(2;1/(Tabelle2!$A:$A&Tabelle2!$B:$B=$A3&B$1);Tabelle2!$C:$C));"";VERWEIS(2;1/(Tabelle2!$A:$A&Tabelle2!$B:$B=$A3&B$1);Tabelle2!$C:$C))

oder mit Matrixformel

=WENN(ISTNV(VERGLEICH(Tabelle1!$A11&Tabelle1!C$1;Tabelle2!$A$1:$A$100&Tabelle2!$B$1:$B$100;0));"";INDEX(Tabelle2!$C:$C;VERGLEICH(Tabelle1!$A11&Tabelle1!C$1;Tabelle2!$A$1:$A$100&Tabelle2!$B$1:$B$100;0)))

Die Eingabe der zweiten Formel muss mit Strg+Shift+Enter bestätigt werden.

Gruß
Rainer

Answer 5

Hallo malSchauen,

fantastisch.
Dein Makro klappt wie ich es wollte. Werd es Morgen gleich auf der Arbeit testen.
Vielen Dank


Hallo rainberg,

deins ist zwar kein Makro, aber ein aufmotzen von meiner alten Formel. Also nun ohne NV-Fehler. Somit auch für mich zu gebrauchen, denn im Notfall kann ich sicherlich auf die schnelle kein Makro zaubern. Dir also auch ein DANKE

Gruß

Answer 6

Hallo malSchaun,

hab doch noch ein kleines Problem mit dem Makro gefunden.
Hab das Problem in meiner 1. Frage wohl selber provoziert.

Also jetzt geht das Makro komplett von links nach rechts durch. Wahrscheinlich bis zur letzten Spalte in der Tabelle.
Es müßte aber so sein, dass wenn er in der Zeile 1 kein Inhalt mehr findet, also leere Zelle, dann muss das Makro stoppen.

Denn danach fängt bei meiner Tabelle ein anderes Thema an.

Kannst Du mir da auch weiterhelfen?

Gruß
Mischi

Answer 7

Hi,

Das Makro geht alle Spalten bis zur letzten beschriebenen Zelle in Zeile1 durch, um die Werte zu ermitteln und in die Tabelle einzutragen. Zuvor löscht es aber von Zelle B2 in Richtung rechts und unten alles bis zur letzten beschriebenen Zelle. Das darf dann sicher auch nicht sein. Ich hab es mal umgebaut, so das es passen sollte:

Sub VerweisAlsMakro()
'Variablendeklaration
'====================
Dim lngQR As Long, lngQC As Long
Dim lngVR As Long, lngVLR As Long
Dim lngQLR As Long, lngQLC As Long
Dim varScratchR As Variant, varScratchC As Variant
Dim shQuel As Worksheet, shVerw As Worksheet

Set shQuel = ThisWorkbook.Sheets("Tabelle1") 'Tabelle1 als Quelle
Set shVerw = ThisWorkbook.Sheets("Tabelle2") 'Tabelle2 als Verweisliste

lngQLR = shQuel.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Reihe in der Quelle
lngVLR = shVerw.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Reihe in Verweis

'letzte Quellspalte ermitteln
If shQuel.Cells(1, 2).Offset(0, 1).Value = "" Then 'Wenn Zelle C1 leer
lngQLC = 2 'nur SpalteB auswerten
Else 'andernfalls
lngQLC = shQuel.Cells(1, 2).End(xlToRight).Column 'letzte fortlaufende Zelle
End If 'Ende Wenn

shQuel.Range("B2", Cells(Rows.Count, lngQLC)).ClearContents 'Werte im Ergebnisbereich löschen

For lngQR = 2 To lngQLR Step 1 'für jede QuellReihe bis Letzte
For lngQC = 2 To lngQLC Step 1 'für jede QuellSpalte bis Letzte
varScratchR = shQuel.Cells(lngQR, 1).Value 'Wert A-Reihe zwischenspeichern
varScratchC = shQuel.Cells(1, lngQC).Value 'Wert Spalte-1 zwischenspeichern
For lngVR = 1 To lngVLR Step 1 'für jede Reihe in Verweis
If shVerw.Cells(lngVR, 1).Value = varScratchR And _
shVerw.Cells(lngVR, 2).Value = varScratchC Then 'Wenn Übereinstimmung
shQuel.Cells(lngQR, lngQC).Value = shVerw.Cells(lngVR, 3).Value 'Ergebnis eintragen
End If
Next
Next
Next
End Sub

bye
malSchauen

Answer 8

Perfekt!

DANKE malSchauen

Bei der Testdatei funktioniert es.
Morgen wird das Makro mit großer Freude in meine Tabelle gepackt. :-)

Gruß
Mischi