Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1624to1628
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
Inhaltsverzeichnis

Werte werden aus andere Liste nit übertrage

Werte werden aus andere Liste nit übertrage
08.06.2018 10:11:01
Hendl91
Hallo ich habe ein Problem ich mölchte aus einer exteren Excel Liste Workorder nummern übertragen. Als referenz nehme ich Den Titel der Arbeit. Wenn noch keine Workorder nummer fergeben wurde möchte ich statt dessen die Auftragsnummer einlessen. Das mit der Workordernummer klappt aber das mit den Auftrags nummern nicht. Kann mir jemand helfen

Public Sub test()
Dim i, j As Integer
'On Error GoTo Fehler
Application.DisplayAlerts = False 'ausschalten
'**Bildschirm ausblenden
Application.ScreenUpdating = False 'Bildschirm auschalten
Application.StatusBar = "Workordernummern werden aktualisiert. Dies kann einige Minuten dauern." _
'öffne jetzt die Datei *************************************
Workbooks.Open Filename:=ThisWorkbook.Path & "\Rep_TA.xlsx", Notify:=False, ReadOnly:=True
For i = 2 To Worksheets(1).UsedRange.Rows.Count
For j = 2 To Workbooks("Rep_TA").Worksheets(1).UsedRange.Rows.Count
If IsEmpty(ThisWorkbook.Worksheets(1).Cells(i, 13)) = False And IsEmpty( _
ThisWorkbook.Worksheets(1).Cells(i, 12)) Then
If InStr(1, ThisWorkbook.Worksheets(1).Cells(i, 13).Text, Workbooks("Rep_TA"). _
Worksheets(1).Cells(j, 2).Text, vbTextCompare)  0 Then
If Workbooks("Rep_TA").Worksheets(1).Cells(j, 6) = "" Then ' hier wird  _
gefragt ob eine Workordernummer exestiert
ThisWorkbook.Worksheets(1).Cells(i, 12).Value = Workbooks("Rep_TA"). _
Worksheets(1).Cells(j, 1)
Else
ThisWorkbook.Worksheets(1).Cells(i, 12) = Workbooks("Rep_TA").Worksheets(1) _
.Cells(j, 6)
End If
End If
End If
Next
Next
Workbooks("Rep_TA").Close savechanges:=False
'On Error GoTo Fehler
Application.DisplayAlerts = True 'ausschalten
'**Bildschirm ausblenden
Application.ScreenUpdating = True 'Bildschirm auschalten
Application.StatusBar = False
MsgBox ("fertig")
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte werden aus andere Liste nit übertrage
12.06.2018 14:06:42
fcs
Hallo Hendl,
ich hab deinen Code mal etwas übersichtlicher gestaltet, indem ich für die geladene Arbeitsmappe und die beiden Tabellenblätter Variablen eingeführt habe.
Offensichtlich möglicher Fehler:
in Zeile
    For i = 2 To Worksheets(1).UsedRange.Rows.Count
fehlt evtl. die Arbeitsmappe zum Worksheet. Sollte wohl besser so sein:
    For i = 2 To ThisWorkbook.Worksheets(1).UsedRange.Rows.Count

Wenn dies nicht der Fehler ist, dann musst du die Logik in den If-Prüfungen uberprüfen.
Evtl. sind die Zelen, die du auf "leer" prüfst nicht leer sondern enthalten einen Leerstring.
If IsEmpty(ThisWorkbook.Worksheets(1).Cells(i, 13)) = False ...
musst du dann ersetzen durch
If Not ThisWorkbook.Worksheets(1).Cells(i, 13)) = "" ...
Gruß
Franz
'Überarbeiteter Code
Public Sub test()
Dim i, j As Integer
Dim wkbRep_TA As Workbook, wksRep_TA1 As Worksheet
Dim wksZ1 As Worksheet
'On Error GoTo Fehler
Application.DisplayAlerts = False 'ausschalten
'**Bildschirm ausblenden
Application.ScreenUpdating = False 'Bildschirm auschalten
Application.StatusBar = "Workordernummern werden aktualisiert. Dies kann einige Minuten dauern." _
_
Set wksZ1 = ThisWorkbook.Worksheets(1)
'öffne jetzt die Datei *************************************
Set wkbRep_TA = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Rep_TA.xlsx", Notify:=False, _
ReadOnly:=True)
Set wksRep_TA1 = wkbRep_TA.Worksheets(1)
For i = 2 To wksZ1.UsedRange.Rows.Count
For j = 2 To wksRep_TA1.UsedRange.Rows.Count
If IsEmpty(wksZ1.Cells(i, 13)) = False And IsEmpty(wksZ1.Cells(i, 12)) Then
If InStr(1, wksZ1.Cells(i, 13).Text, wksRep_TA1.Cells(j, 2).Text, _
vbTextCompare)  0 Then
If wksRep_TA1.Cells(j, 6) = "" Then ' hier wird gefragt ob eine _
Workordernummer exestiert
wksZ1.Cells(i, 12).Value = wksRep_TA1.Cells(j, 1)
Else
wksZ1.Cells(i, 12) = wksRep_TA1.Cells(j, 6)
End If
End If
End If
Next j
Next i
wkbRep_TA.Close savechanges:=False
'On Error GoTo Fehler
Application.DisplayAlerts = True 'ausschalten
'**Bildschirm ausblenden
Application.ScreenUpdating = True 'Bildschirm auschalten
Application.StatusBar = False
MsgBox ("fertig")
End Sub

Anzeige

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige