Thema Datum  Von Nutzer Rating
Antwort
Rot Nummern auf Gleichheit überprüfen und nebeneinander kopieren
10.05.2014 14:02:11 Eli
NotSolved
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:
Eli
Datum:
10.05.2014 14:02:11
Views:
1414
Rating: Antwort:
  Ja
Thema:
Nummern auf Gleichheit überprüfen und nebeneinander kopieren

Hallo liebes VBA-Forum!

Ich bin absoluter Frischling in VBA und hätte ein (vermutlich eher einfaches) Problem. Ich habe zwei Excel-Tabellen mit jeweils einer langen Liste (2 Spalten) an Nummern:

Excel1:
100001  56
100002  23
100003  80
100004  79
100005  72

Excel2:
100003  43
100001  13
100004  21
100002  34

Ich möchte jetzt die Nummern in der ersten Spalte (z.B ID 100001) aus Excel1 in Excel2 suchen lassen. Wenn sie in Excel2 gefunden wurde, möchte ich, dass sie in Excel1 an die entsprechende Stelle mit der Nummer daneben in die selbe Zeile hinkopiert wird.

Also so: Excel1
100001  56  100001  13
100002  23  100002  34
100003  80  100003  43
100004  79  100004  21
100005  72

Ich hab schon zwei Schleifen da, die super funktionieren. Mein einziges Problem ist nur, dass wenn eine ID in Excel2 garnicht vorkommt, also wie Ihr oben seht z.B. die 100005, dann bekomm ich eine Fehlermeldung, weil ich (noch) nicht definiert hab, was er dann machen soll. Ich würde an einer solchen Stelle gern eine andere Zahl, z.B. eine "-99" ins ID-Feld eintragen lassen oder sie auch ganz leer lassen, da bin ich jetzt flexibel. Leider weiß ich nicht, wie ein passender Code dazu heißen kann und wo ich ihn einfügen kann. Ich hab Euch meinen Code mal angefügt.

Sub Zuordnung()

    Dim g As String    'ID in Tabelle1
    Dim y As String    'Zeilenvariable ID Tabelle1
    Dim z As String    'Zeilenvariable ID Tabelle2
    Dim f As String    'ID in Tabelle2

z = 2
y = 3
    
Do
 y = y + 1
 
    Windows("Excel1.xls").Activate
    Sheets("Tabelle1").Select
    g = Cells(y, 2)
    
    If g < "100" Then
    GoTo 333
    End If
   
   Cells(y, 2).Select 'erste ID merken
   Selection.Copy
   
   Windows("Excel2.xls").Activate
   Sheets("Tabelle2").Select
   
   Do
   z = z + 1
   f = Cells(z, 1)  
           
   If f = g Then
   
    Windows("Excel2.xls").Activate
    Sheets("Tabelle2").Select
   
    Cells(z, 1).Select 'kopiert ID
    Selection.Copy
    
    Windows("Excel1.xls").Activate
    Sheets("Tabelle1").Select
   
    Cells(y, 6).Select 'kopierte ID eintragen
    ActiveSheet.Paste
    Application.CutCopyMode = False
   
   
    Windows("Excel2.xls").Activate
    Sheets("Tabelle2").Select
   
    Cells(z, 5).Select 'kopiert Nummer
    Selection.Copy
    
    Windows("Excel1.xls").Activate
    Sheets("Tabelle1").Select
   
    Cells(y, 7).Select 'kopierte Nummer eintragen
    ActiveSheet.Paste
    Application.CutCopyMode = False

   f = 1000
   z = 2
     
   Else
     z = z
   End If
        
   Loop Until f = 1000
   
333
   Loop Until y = 1200

   ActiveWorkbook.Save
'   ActiveWorkbook.Close
   
End Sub

Wenn Ihr mir in diesem Problem helfen könntet, wäre ich sehr froh! Vielen Dank derweil!

Eli


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 Nummern auf Gleichheit überprüfen und nebeneinander kopieren
10.05.2014 14:02:11 Eli
NotSolved
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