Ich weiß nicht was deine zuvor eingegeben Werte mit einer
dateisuche zu tun haben könnten.
Die Dateisuche braucht nur die drei eben beschriebenen
Parameter.
Wenn ich das richtig verstanden habe, wird über das eigentliche Dokument eine Suche geöffnet. In dieser Suche gebe ich verschiedene Informationen an (Dateiname, zielmonat, quellmonat) und anhand dieser Informationen wird die ursprüngliche Exceldatei ergänzt…
Unten mal das komplette Makro. Bin da grad recht aufgeschmissen, zumal ich dieses Makro von einem Kollegen übernommen habe und der Kollege nicht mehr ansprechbar ist.
Gruß und Dank
Patrick
Option Explicit
Const pfad As String = „S:\Daten“
Const target As String = „Global2011.xls“
Const target_sheet As String = „data“
Sub req_transfer()
'This sub transfers the requirements from the downloaded
'requirements data base into this file
'dimension of needed variables
Dim requirements As Double
Dim file, material, line, list_L2_customers, customer As String
Dim target_row, source_row, target_month As Integer
Dim source_material_column, source_req_column, source_month As Integer
Dim max, start, target_material_column, target_req_column, i As Integer
'*************************************************
'* target file parameters *
'*************************************************
max = 41 'number of products
start = 3 'row with first matrerial number
target_material_column = 6 'column in target file with material discriptions fro Lotus Notes
target_req_column = 6 'column in target file for requirements quantity
'*************************************************
'* source file parameters *
'*************************************************
source_material_column = 2 'column with material discriptions from Lotus Notes
source_req_column = 3
'--------------------------------------------------
'Input of the file name
file = InputBox(„Please enter file name like REQ without .xls, only REQ :“, „Input file name“)
If file = „“ Then GoTo label1
source_month = InputBox(„Please enter the month from the REQ-database you want to transfer 1,2,3…“, „Input month“)
If source_month 12 Then GoTo label1
'if source_month not valid then goto label1 = EndSub
target_month = InputBox(„Please enter the planning month“, „Input month“)
If target_month 12 Then GoTo label1
'if target_month not valid then goto label1 = EndSub
Application.ScreenUpdating = False
’ search for the from Lotus Notes exported REQ sheet
With Application.FileSearch
.NewSearch
.LookIn = pfad
.SearchSubFolders = True
.Filename = file & „.xls“
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then .MatchTextExactly = True
.FileType = msoFileTypeAllFiles
End With
If Application.FileSearch.MatchTextExactly = True Then 'if file has been found
Workbooks.OpenText (pfad & file & „.xls“) 'open source file
Sheets(„A“).Select
Sheets(„A“).Copy after:=Workbooks(target).Sheets(1) 'copy requirement sheet to this file
Workbooks(file & „.xls“).Close savechanges:=False 'closes the requirement file
i = 1
Sheets(„A“).Select
‚fills in the source the material discription where it‘ missing
‚because it‘ opened to see the the customer names
While Cells(i + 1, 2) „“ Or Cells(i + 1, 3) „“
If Cells(i + 1, 2) = „“ Then
Cells(i + 1, 2) = Cells(i, 2)
End If
i = i + 1
Wend
'deletes the part sum for the materials where the customer names
'are shown
i = 1
While Cells(i + 1, 2) „“
If Cells(i + 1, 2) „“ And Cells(i + 1, 3) „“ And Cells(i, 3) = „“ Then
Rows(i).Select
Selection.Delete Shift:=xlUp
End If
i = i + 1
Wend
Sheets(target_sheet).Select
Cells(1, target_req_column + target_month) = source_month 'fills in row 1 the planning month
’
For target_row = start To start + max - 1
material = Cells(target_row, target_material_column)
line = Right(Cells(target_row, 1), 2) 'gets the Line Line 1 or Line 2
list_L2_customers = Cells(target_row, 10) 'gets the List of L2 customers
If material = „“ Then GoTo label2
Sheets(„A“).Select 'selects source sheet
requirements = 0
source_row = 1
While Cells(source_row, source_material_column) „“
If Cells(source_row, source_material_column) = material Then
If line = „L1“ Then
If InStr(list_L2_customers, Cells(source_row, source_material_column + 1)) = 0 Then
requirements = requirements + Cells(source_row, source_req_column + source_month)
GoTo label3
End If
End If
If line = „L2“ Then
If InStr(list_L2_customers, Cells(source_row, source_material_column + 1)) > 0 Then
requirements = requirements + Cells(source_row, source_req_column + source_month)
GoTo label3
End If
End If
If line „L1“ And line „L2“ Then
requirements = requirements + Cells(source_row, source_req_column + source_month)
End If
End If
label3:
source_row = source_row + 1
Wend
Sheets(target_sheet).Select
Cells(target_row, target_req_column + target_month) = Round(requirements / 1000, 2)
label2:
Next target_row
Else
MsgBox (" File not found")
End If
label1:
Application.DisplayAlerts = False
Sheets(„A“).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function
