Thema Datum  Von Nutzer Rating
Antwort
10.05.2014 14:02:11 Eli
NotSolved
Blau Nummern auf Gleichheit überprüfen und nebeneinander kopieren
10.05.2014 14:41:45 Gast87624
NotSolved
11.05.2014 21:19:31 Eli
NotSolved
11.05.2014 21:19:36 Eli
NotSolved
11.05.2014 21:19:40 Eli
NotSolved

Ansicht des Beitrags:
Von:
Gast87624
Datum:
10.05.2014 14:41:45
Views:
986
Rating: Antwort:
  Ja
Thema:
Nummern auf Gleichheit überprüfen und nebeneinander kopieren

Hi Eli,

probier es mal wie folgt:

Es wird davon ausgegangen das auf beiden Blättern die IDs in Spalte A stehen und die dazugehörigen Werte in Spalte B.

Bei Blätter befinden sich hier in derselben Mappe.

Option Explicit

Sub Test()
  
  Dim wks1 As Excel.Worksheet
  Dim wks2 As Excel.Worksheet
  Dim rng1 As Excel.Range
  Dim rng2 As Excel.Range
  Dim strFormula As String
  
  'Blatt1 referenzieren
  Set wks1 = ThisWorkbook.Worksheets("Tabelle1") '<- ggf. anpassen
  'Blatt2 referenzieren
  Set wks2 = ThisWorkbook.Worksheets("Tabelle2") '<- ggf. anpassen
  
  'letzte Zelle mit Inhalt in Spalte A, Blatt1 ermitteln
  Set rng1 = wks1.Cells(wks1.Rows.Count, "A").End(xlUp)
  'Bereich1: A1 bis zur gefundenen Zelle in Blatt1 (zB. A1:A10) referenzieren
  Set rng1 = wks1.Range(wks1.Range("A1"), rng1)
  
  'Bereich2: gesamte Spalten A und B im Blatt2
  Set rng2 = wks2.Columns("A:B")
  
  'der gleiche Bereich1, nur drei Spalten nach rechts versetzt betrachtet
  With rng1.Offset(ColumnOffset:=3)
    'Daten mit SVERWEIS (engl. VLOOKUP) suchen
    strFormula = "VLOOKUP(RC[-3]," & rng2.Address(ReferenceStyle:=xlR1C1, External:=True) & ",2,FALSE)"
    strFormula = "=IF(ISERROR(" & strFormula & "),""""," & strFormula & ")"
    .FormulaR1C1 = strFormula
'    .Value = .Value 'Formeln in Werte umwandeln
  End With
  
  'der gleiche Bereich1, nur zwei Spalten nach rechts versetzt betrachtet
  With rng1.Offset(ColumnOffset:=2)
    .FormulaR1C1 = "=IF(RC[1]<>"""",RC[-2],"""")"
'    .Value = .Value 'Formeln in Werte umwandeln
  End With
  
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
10.05.2014 14:02:11 Eli
NotSolved
Blau Nummern auf Gleichheit überprüfen und nebeneinander kopieren
10.05.2014 14:41:45 Gast87624
NotSolved
11.05.2014 21:19:31 Eli
NotSolved
11.05.2014 21:19:36 Eli
NotSolved
11.05.2014 21:19:40 Eli
NotSolved