Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon mischi1978 vom 13.10.2021, 21:08 Options

Marko Formel - Verweis - ändern in ein Makro

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

Antwort schreiben

Antwort 1 von malSchauen vom 13.10.2021, 21:56 Options

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 http://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

Antwort 2 von mischi1978 vom 14.10.2021, 00:33 Options

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ß

Antwort 3 von malSchauen vom 14.10.2021, 01:07 Options

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

Antwort 4 von rainberg vom 14.10.2021, 07:40 Options

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

Antwort 5 von mischi1978 vom 14.10.2021, 21:27 Options

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ß

Antwort 6 von mischi1978 vom 15.10.2021, 21:21 Options

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

Antwort 7 von malSchauen vom 15.10.2021, 22:31 Options

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

Antwort 8 von mischi1978 vom 15.10.2021, 23:00 Options

Perfekt!

DANKE malSchauen

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

Gruß
Mischi

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..