Thema Datum  Von Nutzer Rating
Antwort
Rot EXCEL 2010 VBA - Werte zwischen Tabellen suchen und übernehmen
13.10.2016 11:07:18 Rübezahl
NotSolved
13.10.2016 13:33:32 Gast70117
*****
Solved
13.10.2016 16:08:28 Gast21985
NotSolved

Ansicht des Beitrags:
Von:
Rübezahl
Datum:
13.10.2016 11:07:18
Views:
1355
Rating: Antwort:
  Ja
Thema:
EXCEL 2010 VBA - Werte zwischen Tabellen suchen und übernehmen

Hallo zusammen,

bin absoluter VBA Anfänger. Habe folgende Aufgabenstellung:

Eine Preisliste (Tabellenblatt 1, Spalte A) soll nach veralteten Preisen aus Referenz (Tabellenblatt 2, SpalteA) durchsucht werden, und diese durch neue korrespondierenden Preise (Tabellenblatt 2, Spalte B) aktualisiert werden.

Die beibehaltenen, und aktualisierten Preise sollen zur besseren Übersichtlichkeit in Tabellenblatt 1, Spalte B aufgelistet werden. So kann man noch mal ein prüfendes Auge darauf werfen. Treffer werden zum Debugging in Tabelle 1/Spalte A gelb markiert.

TABELLE 1 / Spalte A: originale Preise

TABELLE 2 / Spalte A: Suchkriterium veralteter Preis
TABELLE2  / Spalte B: ersetzender neuer Preis

TABELLE 1 / Spalte B: überarbeitete Preisliste

 

Mein Problem:

Das Makro erkennt die zu aktualisierenden Preise, ändert aber nur den (wen überhaupt) den letzten Treffer.

Hier das Makro:

Sub WerteTausch()

Dim Zeilen1 As Long
Dim Zeilen2 As Long

' Tabelle1 enthält zu durchsuchende Preisliste
' Anzahl der Einträge bestimmen
Zeilen1 = Sheets("Tabelle1").UsedRange.Rows.Count

' Tabelle2 enthält zu suchende Preise und aktualisierten Preis
' Anzahl der Einträge bestimmen
Zeilen2 = Sheets("Tabelle2").UsedRange.Rows.Count

For n = 1 To Zeilen1
  For m = 1 To Zeilen2
    If Sheets("Tabelle1").Range("A" & n).Value = Sheets("Tabelle2").Range("A" & m).Value Then
          ' zu aktualisierenden Preis gefunden und Neupreis aus Tabelle2/SpalteB holen
          Sheets("Tabelle1").Range("B" & n).Value = Sheets("Tabelle2").Range("B" & m).Value
          ' veralteten Preis noch gelb markieren :)
          Cells(n, 1).Interior.ColorIndex = 6
    Else
          ' keine Preisänderung, Wert rüberkopieren
      Sheets("Tabelle1").Range("B" & n).Value = Sheets("Tabelle1").Range("A" & n).Value
    End If
  Next
Next

End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot EXCEL 2010 VBA - Werte zwischen Tabellen suchen und übernehmen
13.10.2016 11:07:18 Rübezahl
NotSolved
13.10.2016 13:33:32 Gast70117
*****
Solved
13.10.2016 16:08:28 Gast21985
NotSolved