Anzeige
Archiv - Navigation
548to552
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
548to552
548to552
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spalte A vergleichen und SpalteB kopieren

Spalte A vergleichen und SpalteB kopieren
18.01.2005 18:17:08
Wolfgang
Hallo zusammen,

Ich habe im Netzwerk eine Tabelle mit dem Namen Mitarbeiter.
MA Ort
Müller Münster
Meier Bochum

usw.

In einer 2 Tabelle habe ich auch die MA ohne den Ort.
Wie kann ich automatisch den Ort aus der Tabelle Mitarbeiter an die Tabelle
2 anfügen.
In der aktuellen Tabelle kommt der Mitarbeiter öfter vor.
Die Tabelle 2 wird täglich neu erstellt und ich möchte nicht immer über
sverweis per Hand das ganze machen.
Wenn möglich per VBA
Dank und Gruß
Wolfgang

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalte A vergleichen und SpalteB kopieren
18.01.2005 18:57:07
Josef
Hallo Wolfgang!
Die Tabellennamen und evtl. die Spalten musst du anpassen!


      
Dim rng As Range
'by J.Ehrensberger
'Suchbegriffe und Suchspalte jeweils "A"
Dim rFind As Range
Dim rng As Range
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lastRow As Long
Set wksQ = Sheets("Tabelle1"'Tabelle min Name und Ort
Set wksZ = Sheets("Tabelle2"'Tabelle mit Namen

lastRow = IIf(wksZ.Range(
"A65536") <> "", 65536, _
            wksZ.Range(
"A65536").End(xlUp).Row)
            
   
For Each rng In wksZ.Range("A1:A" & lastRow)
      
If rng <> "" Then
      
Set rFind = wksQ.Range("A:A").Find(What:=rng)
         
If Not rFind Is Nothing Then
            rng.Offset(0, 1) = rFind.Offset(0, 1)
         
End If
      
End If
   
Next
End Sub 
Gruß Sepp
Anzeige
da ist was Schiefgelaufen!
18.01.2005 19:00:26
Josef
Hallo nochmal!
Da ist beim Kpieren was schiefgegangen! ;-)


      
Sub vergleichenKopieren()
'by J.Ehrensberger
'Suchbegriffe und Suchspalte jeweils "A"
Dim rFind As Range
Dim rng As Range
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lastRow As Long
Set wksQ = Sheets("Tabelle1"'Tabelle min Name und Ort
Set wksZ = Sheets("Tabelle2"'Tabelle mit Namen

lastRow = IIf(wksZ.Range(
"A65536") <> "", 65536, _
            wksZ.Range(
"A65536").End(xlUp).Row)
            
   
For Each rng In wksZ.Range("A1:A" & lastRow)
      
If rng <> "" Then
      
Set rFind = wksQ.Range("A:A").Find(What:=rng)
         
If Not rFind Is Nothing Then
            rng.Offset(0, 1) = rFind.Offset(0, 1)
         
End If
      
End If
   
Next
End Sub 
Anzeige
AW: Spalte A vergleichen und SpalteB kopieren
Wolfgang
Hallo Josef,
erstmal danke für die schnelle Antwort.
Kann ich auf eine Mappe zugreifen die im Netzwerk liegt.
Z.B. G:\data\mitarbeiter.xls Tabelle1
AW: Spalte A vergleichen und SpalteB kopieren
18.01.2005 19:26:36
Josef
Hallo Wolfgang!
Dann so:


      
Sub vergleichenKopieren()
'by J.Ehrensberger
'Suchbegriffe und Suchspalte jeweils "A"
Dim rFind As Range
Dim rng As Range
Dim wkb As Workbook
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lastRow As Long
On Error GoTo ERRORHANDLER
Application.ScreenUpdating = 
False
Set wkb = Workbooks.Open("G:\data\mitarbeiter.xls")
Set wksQ = wkb.Sheets("Tabelle1"'Tabelle min Name und Ort
Set wksZ = Sheets("Tabelle2"'Tabelle mit Namen

lastRow = IIf(wksZ.Range(
"A65536") <> "", 65536, _
            wksZ.Range(
"A65536").End(xlUp).Row)
            
   
For Each rng In wksZ.Range("A1:A" & lastRow)
      
If rng <> "" Then
      
Set rFind = wksQ.Range("A:A").Find(What:=rng)
         
If Not rFind Is Nothing Then
            rng.Offset(0, 1) = rFind.Offset(0, 1)
         
End If
      
End If
   
Next
wkb.Close , 
False
ERRORHANDLER:
Application.ScreenUpdating = 
True
End Sub 
Anzeige
AW: Spalte A vergleichen und SpalteB kopieren
Wolfgang
Hallo Josef,
du bist ja schneller als die Feuerwehr.
klappt super
Besten Dank
Wolfgang Roßbach

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige