AW: hier die fehlenden infos!!!
19.06.2007 20:49:56
Chaos
Servus,
warum nicht gleich so? Sind ja schon fast am Ziel:
Sub suche1()
Dim Wert, wert1
Dim i As Byte
Dim ordner As String, datei As String, n As String, a As String
Application.DisplayAlerts = False
On Error Resume Next
n = ActiveWorkbook.Name
ordner = ActiveWorkbook.Sheets("Tabelle1").Range("B1").Value
datei = ActiveWorkbook.Sheets("Tabelle1").Range("B2").Value
For i = 9 To 100
Wert = ActiveWorkbook.Sheets("Tabelle1").Range("A" & i).Value
Workbooks.Open Filename:="C:\Dokumente und Einstellungen\Desktop\TXT-Dateien\" & ordner & "\" & _
datei & " _
.xls"
With ActiveWorkbook
ActiveWorkbook.Sheets("GESAM").Range("B1").ClearContents
ActiveWorkbook.Sheets("GESAM").Range("A9:A100").Select
Selection.Find(What:=Wert, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
:=False).Activate
If ActiveCell.Value Wert Then
GoTo weiter
Else
ActiveCell(1, 3).Select
wert1 = ActiveCell.Value
ActiveWorkbook.Sheets("GESAM").Range("B1").Value = wert1
GoTo weiter
End If
End With
weiter:
With ActiveWorkbook
If ActiveWorkbook.Sheets("GESAM").Range("B1").Value = "" Then
ActiveWorkbook.Sheets("GESAM").Range("B1").Value = "0,00 "
End If
End With
With Workbooks(n)
Workbooks(n).Sheets("Tabelle1").Range("C" & i).Value = Workbooks(datei & ".xls").Sheets(" _
_
GESAM").Range("B1").Value
ActiveWorkbook.Close
End With
Next i
Application.DisplayAlerts = True
End Sub
Das Makro, macht genau das.
1. nimmt den Wert aus Zelle A i (von 9 bis 100) , sucht diesen in der anderen Datei und schriebt ihn, wenn vorhanden in die Zelle (Spalte C) neben den Suchwert.
Wenn der Wert nicht vorhanden ist, dann steht da 0,00 Euro (als Text). Willst du das als Zahl muß die Zelle B1 in der Quelldateals Währung formatiert werden und das ="0,00" in =0 umgewandelt werden.
Habe das getestet und das funktioniert auch.
oder, wenn die Zieldatei immer Zusammenfassung.xls heißt, dann auch so:
Sub suche1()
Dim Wert, wert1
Dim i As Byte
Dim ordner As String, datei As String, n As String, a As String
Application.DisplayAlerts = False
On Error Resume Next
n = ActiveWorkbook.Name
ordner = Workbooks("Zusammenfassung.xls").Sheets("Tabelle1").Range("B1").Value
datei = Workbooks("Zusammenfassung.xls").Sheets("Tabelle1").Range("B2").Value
Workbooks.Open Filename:="C:\Dokumente und Einstellungen\Desktop\TXT-Dateien\" & ordner & "\" & _
datei & " _
.xls"
For i = 9 To 100
Wert = Workbooks("Zusammenfassung.xls").Sheets("Tabelle1").Range("A" & i).Value
With ActiveWorkbook
ActiveWorkbook.Sheets("GESAM").Range("B1").ClearContents
ActiveWorkbook.Sheets("GESAM").Range("A9:A100").Select
Selection.Find(What:=Wert, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
:=False).Activate
If ActiveCell.Value Wert Then
GoTo weiter
Else
ActiveCell(1, 3).Select
wert1 = ActiveCell.Value
ActiveWorkbook.Sheets("GESAM").Range("B1").Value = wert1
GoTo weiter
End If
End With
weiter:
With ActiveWorkbook
If ActiveWorkbook.Sheets("GESAM").Range("B1").Value = "" Then
ActiveWorkbook.Sheets("GESAM").Range("B1").Value = "0,00 "
End If
End With
With Workbooks(n)
Workbooks(n).Sheets("Tabelle1").Range("C" & i).Value = Workbooks(datei & ".xls").Sheets(" _
_
GESAM").Range("B1").Value
End With
Next i
Application.DisplayAlerts = True
End Sub
Dann sparst du dir das ständige Öffnen und schließen der Quelldatei. Viel Spaß. Falls was unverständlich ist, kannst du gerne weiterfragen.
Gruß
Chaos