Registriert seit: 03.10.2018
Version(en): 2016
was ich noch festgestellt habe, das makro sagt immer, "In Materialübersicht nicht gefunden!" aber die pack stücke sind in der Materialübersicht drine.
Kann es sein, das irgendwas falsch gemacht habe beim anpassen?
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen,
Zitat:Kann es sein, das irgendwas falsch gemacht habe beim anpassen?
kann ich nicht ausschließen. In dem Beispiel wird ja was gefunden und auch übertragen …
Zitat:Weiterhin würde es sehr gut sein wenn das Marko die Tabelle selber öffnet.
Wenn die Datei dort liegt wo Du den Pfad programmiert hast sollte sie auch aufgehen.
Zitat:Kann man den Code abändert, das es zuerst die Transportnummer sucht,
… wird schwierig. Du würdest dann Daten aus verschiedenen Spalten von bestimmten Zeilen der einen Datei in bestimmte zusammenhängende Spalten der gefilterten Zeilen der anderen übertragen müssen … Vom Prinzip her könnte man das mit Arrays lösen - erst die Quellzeile einlesen, dann in ein zweites Array nur die betreffenden Zellen aus dem ersten Array übertragen und dann das zweite Array in den Zielbereich schreiben.
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 03.10.2018
Version(en): 2016
04.02.2020, 13:51
(Dieser Beitrag wurde zuletzt bearbeitet: 04.02.2020, 13:51 von Pirat2015.)
schauan --> OK
aber jetzt zu diesen CODE: Hier gib doch ein Befehl welche besagt die Tabelle zu öffnen wenn die geschlossen ist, es passiert aber nicht. Wie ändere ich das?
Code: On Error Resume Next
'Prüfen ob Materialliste offen ist, sonst Öffnen!
Set WbMt = Workbooks(MTL).Worksheets(1)
If Err > 0 Then
Workbooks.Open Pfad & MTL
Set WbMt = Workbooks(MTL).Worksheets(1)
End If
On Error GoTo 0
und dann habe ich mit F8 den Code Laufen lassen er hängt in diese Warte Schleife
Code: If Not rFind Is Nothing Then
Adr1 = rFind.Address
Do
rFind.Offset(0, 42) = AC.Offset(0, 19) 'ETA Port
rFind.Offset(0, 43) = AC.Offset(0, 9) 'Container Nr.
rFind.Offset(0, 44) = AC.Offset(0, 12) 'Transpor Nr.
Set rFind = WbMt.Columns(1).FindNext(rFind)
Loop Until Adr1 = rFind.Address
End If
Next AC
an was kann liegen?
und was muss ich beim MTL angeben? nur die Datei Name oder auch was anderes.
PS: meine Datei liegt auf einen Server : ist die Eingabe der Adresse so richtig
Code: ption Explicit
Const MTL = "Dateiname.xlsm"
Const Status = "I1" 'Zelle f?r Statusanzeige F1
Const Pfad = "file:///\\opc.test.com/ und so weiter --> ich kopiere den Pfad direkt aus der Excel
Danke
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
04.02.2020, 17:50
(Dieser Beitrag wurde zuletzt bearbeitet: 04.02.2020, 18:02 von schauan.)
Hallöchen,
Datei öffnen:
Der Code aktiviert die Datei falls sie offen ist. Falls nicht, versucht er, sie mit den programmierten Daten für Pfad und Dateiname zu öffnen. Da die Fehlermeldungen deaktiviert sind, merkst Du an der Stelle nicht, ob da was nicht stimmt.
Du könntest das so abändern:
Code: On Error Resume Next
'Prüfen ob Materialliste offen ist, sonst Öffnen!
Set WbMt = Workbooks(MTL).Worksheets(1)
If Err > 0 Then
err.clear
Workbooks.Open Pfad & MTL
if err > 0 then Msgbox "Datei nicht vorhanden, ich beende!": Exit sub
Set WbMt = Workbooks(MTL).Worksheets(1)
End If
On Error GoTo 0
"lange Leitung"
Dein Code hält sich vermutlich lange auf, weil Du z.B. eventuell nach einem Leerstring suchst, wenn in AC mal nix steht. Da Du in der Suche die komplette Spalte hast, könnte die Anzahl Leerzellen im 7-stelligen Bereich liegen und das zu durchsuchen dauert schoon etwas ...
Server:
wenn ich mal was auf einem Server liegen habe, dann ist das bei mir in der Regel nicht im Internet. Deine Adresse sieht so aus …
Also bei mir steht dann z.B. etwas wie \\server\freigabe\pfad\datei
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 03.10.2018
Version(en): 2016
OK, ich sehe gerade das der pfad falsch ist, excel schreib das er keine Verbindung zu der Datei aufbauen kann.
Die Datei liegt in der Claud und ich verwende den genauen pfad aus der excel selber.
Was kann ich da machen?
zu der Schleife, ich möchte ja daß das Makro nur eine Spalte genau nach den Packstücken durchsucht welche in der Colliliste sind.
Sobald der letze Packstück aus der Colli liste in Materialübersicht liste gefunden ist, soll die Suche unterbrochen werden.
Wie kann man das machen?
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen,
eventuell musst Du nicht die ganze Spalte durchsuchen. Du könntest den Bereich z.B. so eingrenzen:
...Range("A1:A" & cells(rows.count,1).end(xlup).row))…
dann sucht er nur bis zur letzten gefüllten Zelle in Spalte A
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 03.10.2018
Version(en): 2016
04.02.2020, 18:41
(Dieser Beitrag wurde zuletzt bearbeitet: 04.02.2020, 19:08 von Pirat2015.)
Habe jetzt die Schleife begrenz:
Code: 'Schleife um alle Transportdaten zu ?bertragen
For Each AC In .Range("D16:D30000" & lz1)
Set rFind = WbMt.Columns(1).Find(What:=AC.Value, After:=WbMt.Cells(1, 1), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
'Fehlermeldung wenn Packst?ck Nr. nicht gefunden wird!!
If rFind Is Nothing Then MsgBox AC & "In SSMS nicht gefunden!"
If Not rFind Is Nothing Then
Adr1 = rFind.Address
Do
rFind.Offset(0, 42) = AC.Offset(0, 19) 'ETA Port
rFind.Offset(0, 43) = AC.Offset(0, 9) 'Container Nr.
rFind.Offset(0, 44) = AC.Offset(0, 12) 'Transpor Nr.
Set rFind = WbMt.Columns(1).FindNext(rFind)
Loop Until Adr1 = rFind.Address
End If
Next AC
bekomme folgenden fehler:
Laufzeitfehler 1004 --> Anwendungs- oder objektdefinierter fehler
Also ich glaube es häng wirklich was an der Schleife:
Ich kann jetzt die Datei öffnen, danach passiert nichts mehr --> wie gesagt mit der F8 geht er immer die schleife neu durch:
Code: If ActiveWindow.Caption = MTL Then ThisWorkbook.Activate
Application.ScreenUpdating = True
With ThisWorkbook.Worksheets(1)
'LastZell in Transportschein Spalte A suchen
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(Status).Value = Empty 'Status l?schen
Application.ScreenUpdating = False
'Schleife um alle Transportdaten zu ?bertragen
For Each AC In .Range("D16:D" & Cells(Rows.Count, 1).End(xlUp).Row)
Set rFind = WbMt.Columns(1).Find(What:=AC.Value, After:=WbMt.Cells(1, 1), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
'Fehlermeldung wenn Packst?ck Nr. nicht gefunden wird!!
If rFind Is Nothing Then MsgBox AC & "In SSMS nicht gefunden!"
If Not rFind Is Nothing Then
Adr1 = rFind.Address
Do
rFind.Offset(0, 42) = AC.Offset(0, 19) 'ETA Port
rFind.Offset(0, 43) = AC.Offset(0, 9) 'Container Nr.
rFind.Offset(0, 44) = AC.Offset(0, 12) 'Transpor Nr.
Set rFind = WbMt.Columns(1).FindNext(rFind)
Loop Until Adr1 = rFind.Address
End If
Next AC
was kann ich machen?
Wenn ich das jetzt so abändere
Code: With ThisWorkbook.Worksheets(1)
'LastZell in Transportschein Spalte A suchen
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(Status).Value = Empty 'Status l?schen
Application.ScreenUpdating = False
'Schleife um alle Transportdaten zu ?bertragen
For Each AC In .Range("A6:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Set rFind = WbMt.Columns(1).Find(What:=AC.Value, After:=WbMt.Cells(4, 1), LookIn:= _
xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
'Fehlermeldung wenn Packst?ck Nr. nicht gefunden wird!!
If rFind Is Nothing Then MsgBox AC & "In SSMS nicht gefunden!"
If Not rFind Is Nothing Then
Adr1 = rFind.Address
Do
rFind.Offset(0, 42) = AC.Offset(0, 19) 'ETA Port
rFind.Offset(0, 43) = AC.Offset(0, 9) 'Container Nr.
rFind.Offset(0, 44) = AC.Offset(0, 12) 'Transpor Nr.
Set rFind = WbMt.Columns(1).FindNext(rFind)
Loop Until Adr1 = rFind.Address
End If
Next AC
Dann kommt die Fehlermeldung Packstück in SSMS nicht gefunden, der gesuchte Packstück steht in Zeile D, was muss ich abändern?
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen,
also, erst mal zur Schleife und dem Find.
Eine Begrenzung hast Du ja schon
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
'Schleife um alle Transportdaten zu ?bertragen
For Each AC In .Range("D16:D30000" & lz1)
korrekt wäre wohl
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
'Schleife um alle Transportdaten zu uebertragen
For Each AC In .Range("D16:D" & lz1)
Spalte D ist doch nicht länger als Spalte A, wo Du lz1 ermittelst?
Hier suchst Du den Wert aus Spalte D in Spalte A
Set rFind = WbMt.Columns(1).Find(What:=AC.Value …
Hier kannst Du auch wieder mit lz1 arbeiten, damit, wie gesagt, bei leerem Eintrag nicht jede Zelle genommen wird, entweder auch mit lz1 arbeiten
Set rFind = WbMt.Range("A16:A" & lz1).Find(What:=AC.Value …
oder vielleicht noch besser, Du suchst nur, wenn was in den Zellen steht:
Statt
Set rFind = WbMt.Range("A16:A" & lz1).Find(What:=AC.Value …
dann
If Ac.Value <> "" Then
Set rFind = WbMt.Range("A16:A" & lz1).Find(What:=AC.Value …
und vor Next AC noch einmal eine Zeile mit End If
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:1 Nutzer sagt Danke an schauan für diesen Beitrag 28
• Pirat2015
Registriert seit: 03.10.2018
Version(en): 2016
Vielen Dank, das Thema hab ich jetzt gelöst.
Ich habe eine andere frage: Die Datei welche mein Code aufmacht liegt auf einen Server, die Excel wird in schreibgeschützten Modus geöffnet und der Code bleib stecken solange man das nicht Manuel bestätigt, das man die Dateil bearbeiten möchte.
weiß du zufällig wie ich es lösen kann --> also Datei soll in Hintergrund aufgemacht werden, daten werden übertragen, Datei wird gespeichert und geschlossen.
Hier nochmal mein neuer kompletter code:
Code: Option Explicit
Const MTL = "Datei Name"
Const Status = "I1" 'Zelle für Statusanzeige F1
Const Pfad = "Pfad"
'** bitte Pfad + Ordner deiner Materialübersicht angeben!!
'Makro zum Übertrag in Excel
'42 ETA Port, 43 Container, 44 Transport Nr --> SSMS
Sub Transportdaten_übertragen()
Dim i As Integer
Dim s As String
'Dim AC As Range
Dim rFind As Range
Dim rQuelle As Range
Dim Adr1 As String
Dim j As Integer
Dim shZiel As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim shQuelle As Worksheet
Set shQuelle = ActiveSheet
On Error Resume Next
'Prüfen ob Materialliste offen ist, sonst Öffnen!
Set shZiel = Workbooks(MTL).Worksheets(1)
If Err > 0 Then
Err.Clear
Workbooks.Open Pfad & MTL, Editable:=True
If Err > 0 Then MsgBox "Datei nicht vorhanden, ich beende!": Exit Sub
Set shZiel = Workbooks(MTL).Worksheets(1)
End If
On Error GoTo 0
If ActiveWindow.Caption = MTL Then ThisWorkbook.Activate
Set rQuelle = shQuelle.UsedRange '.Columns("A")
For i = 6 To rQuelle.Rows.Count
s = rQuelle.Cells(i, 1)
Set rFind = shZiel.Columns(4).Find(What:=s, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
'Fehlermeldung wenn Packstück Nr. nicht gefunden wird!!
If rFind Is Nothing Then
Debug.Print "Packstück " & s & " in Datei nicht gefunden!"
Else
Adr1 = rFind.Address
Do
rFind.Offset(0, -3).Offset(0, 42) = rQuelle.Cells(i, 10) 'Container Nr.
rFind.Offset(0, -3).Offset(0, 43) = rQuelle.Cells(i, 20) 'ETA Port
rFind.Offset(0, -3).Offset(0, 44) = rQuelle.Cells(i, 13) 'Transpor Nr.
Set rFind = shZiel.Columns(4).FindNext(rFind)
Loop While Adr1 <> rFind.Address
End If
Next
'Anzeige der übertragenen Daten in Zelle I1
shQuelle.Range(Status).Value = "Daten von Packstück " & shQuelle.Cells(6, 1) & " bis " & shQuelle.Cells(rQuelle.Rows.Count, 1) & " übertragen"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
|