Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
332to336
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
332to336
332to336
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro

Makro
05.11.2003 16:14:39
Daniela
Hallo Zusammen

Kann mir jemand bei diesem Fall helfen. Leider reichen meinen VBA Kenntnisse für dies nicht mehr aus.

Vielen Dank im Voraus.

Problem:

Datei 1

A | B | C | D | E | P |

1 3 x

_______________________________________

Datei 2

A | B | C | D | ..... | F |
Wert1 Wert2 Datum

Wenn die Wertekombination einer Zeile der Spalte A und B der Datei 1 (im Beispiel 1 und 3) in der Datei 2 in einer Zeile der Spalten B und C ( Wert 1 und Wert2) vorkommt dann soll das Datum, welches sich in der Spalte F der Datei 2 befindet in die Spalte P der Datei 1 kopieren (x). Falls dies Kombination in Datei 2 nicht zu finden ist soll nichts in der Spalte P der Datei 1 eingtragen werden.

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

Betreff
Datum
Anwender
Anzeige
AW: Makro
05.11.2003 16:36:26
Markus
Hallo,

vielleicht verstehe ich von der Skizze das Problem her nicht, aber: Wenn es nicht zu viele Daten sind, loop doch einfach durch.
For t = 1 to Ende
If tabelle1.cells(t,1) = tabelle2.cells(t,2) and tabelle1.cells(t,2) = tabelle2.cells(t,3) then tabelle1.cells(t,p) = tabelle2.cells(t,f)
netx t

???
AW: Makro
05.11.2003 16:37:30
Markus
OOps,

kam gerade aus einer anderen Sprache: Zuweisung der Zellen zu Tabellen nicht über diese Notation, sondern "Worksheets("Tabelle1").Cells(.... etc.

Markus
AW: Makro
05.11.2003 17:01:42
Klaus Schubert
Hallo Daniela,

hier mal auf die Schnelle etwas Code, bitte ausgiebig testen (ich hoffe,er funktioniert in deinem Sinne). Die Namen der Dateien und der entsprechenden Tabellblätter bitte anpassen:


Sub Vergleichen()
Dim Datei1 As Object, Datei2 As Object, i1 As Integer, i2 As Integer
Dim EndeDatei1 As Integer, EndeDatei2 As Integer
Set Datei1 = Workbooks("Mappe1.xls").Sheets("Tabelle1")'Namen anpssen
Set Datei2 = Workbooks("Mappe2.xls").Sheets("Tabelle1")'Namen anpassen
EndeDatei1 = Datei1.Cells(Cells.Rows.Count, 1).End(xlUp).Row
EndeDatei2 = Datei2.Cells(Cells.Rows.Count, 2).End(xlUp).Row
For i1 = 1 To EndeDatei1
For i2 = 1 To EndeDatei2
If Datei1.Cells(i1, 1) = Datei2.Cells(i2, 2) And Datei1.Cells(i1, 2) = Datei2.Cells(i2, 3) Then
Datei2.Cells(i2, 6).Copy Datei1.Cells(i1, 16)
Exit For
Else
Datei1.Cells(i1, 16) = ""
End If
Next i2
Next i1
End Sub


Gruß Klaus
Anzeige
AW: Makro
06.11.2003 07:35:15
Daniela
Vielen Dank für Deine rasche Hilfe. Leider bin ich dennoch an einer Kleinigkeit hängen geblieben. Und zwar habe ich die Dateinamen und die Sheetnames angepasst dennoch bringt er nun die Fehlermeldung "Run-time error '9': Subscript out of range". Ich nehme an, dass das daran liegt, dass beide Dateien zwar unter dem selben Pfad gespeichert sind das System aber die zweite Datei nicht finden kann. Also habe ich darauf versucht dies so einzugeben:

Set Datei2 = Workbooks("C:\........\...xls").Sheets("close_out_final_vis")

leider geht dies nicht. Was habe ich falsch gemacht?
AW: Makro
06.11.2003 17:19:07
Klaus Schubert
Hallo Daniela,

ich war davon ausgegangen, das die zweite Arbeitsmappe auch geöffnet ist,deshalb der Fehler. Hier nun geänderter Code, wobei die zweite Arbeitsmappe geöffnet wird und dann nach der Prozedur, ohne gespeichert zu werden, wieder geschlossen wird. der Code muß in der Datei 1 stehen, die Datei 2 wird aufgerufen:


Sub Vergleichen()
Dim Datei1 As Object, Datei2 As Object, i1 As Integer, i2 As Integer
Dim EndeDatei1 As Integer, EndeDatei2 As Integer
Dim NameDatei1 As String, NameDatei2 As String, Pfad As String
Dim TabelleDatei1 As String, TabelleDatei2 As String
Application.ScreenUpdating = False
Pfad = "C:\Dokumente und Einstellungen\Daniela\Eigene Dateien\" 'Pfad anpassen
NameDatei1 = "Mappe1.xls" 'Namen anpassen
TabelleDatei1 = "Tabelle1" 'Namen anpassen
NameDatei2 = "Mappe2.xls" 'Namen anpassen
TabelleDatei2 = "Tabelle1" 'Namen anpassen
Workbooks.Open Filename:=Pfad & NameDatei2 'Zweite Arbeitsmappe öffnen
Set Datei1 = Workbooks(NameDatei1).Sheets(TabelleDatei1)
Set Datei2 = Workbooks(NameDatei2).Sheets(TabelleDatei2)
EndeDatei1 = Datei1.Cells(Cells.Rows.Count, 1).End(xlUp).Row
EndeDatei2 = Datei2.Cells(Cells.Rows.Count, 2).End(xlUp).Row
For i1 = 1 To EndeDatei1
For i2 = 1 To EndeDatei2
If Datei1.Cells(i1, 1) = Datei2.Cells(i2, 2) And Datei1.Cells(i1, 2) = Datei2.Cells(i2, 3) Then
Datei2.Cells(i2, 6).Copy Datei1.Cells(i1, 16)
Exit For
Else
Datei1.Cells(i1, 16) = ""
End If
Next i2
Next i1
Workbooks(NameDatei2).Close savechanges:=False 'Zweite Arbeitsmappe ohne speichern schließen
Application.ScreenUpdating = True
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige