Guten Morgen,
ich habe mit einer Auswertung ein Problem. Und zwar wird in dem untenstehenden Code die Zeile (Cells(vZelle, 63).Value = date_closed)
übersprungen. Aber nur bei automatischen durchlauf, wenn ich es langsam Schrittweise mit F8 durchlaufen lasse, dann wird der Wert
in die Zeile geschrieben. Ich habe schon herum probiert, finde aber keine Lösung.
Zum Programm:
Ich schaue in meiner Tabelle nach, ob schon ein Datum vorhanden ist (der fette Bereich im Code), wenn nicht, dann berechne ich die Dauer in Monaten zum heutigen Tag.
Und möchte den Wert in vZelle,63 schreiben. Was davor kommt, dient dazu in der anderen Tabelle den WErt zu finden, bzw das eingetragene Datum
in vZelle,59 mit dem Datum der anderen Datei zu vergleichen (mehere Dateien vorhanen mit Endung 2012, 2013 usw.)
Es funktioniert alles, bis auf den Punkt, dass der WErt nicht in die Tabelle geschrieben wird.
Hoffe, dass von euch jemand Rat weiß, die Datei kann ich aus Datenschutzgründen nicht hochladen.
Grüße
Sub Test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Dateiname As String
Dim hhh As Double
Dim xxx As Double
Dim loc As Integer
Dim date_closed As String
Dim LZ As Integer
ThisWorkbook.Sheets("test").Range("a10").Select
LZ = Range("a10").End(xlDown).Row
loc = (Range("BJ10").End(xlDown).Row)
Dateiname = Dir("DATEI")
Do While Dateiname <> ""
Set ext_wb = Workbooks.Open("DATEI")
For vZelle = 91 To LZ
hhh = Mid(Dateiname, 31, 4)
xxx = ThisWorkbook.Sheets("test").Cells(vZelle, 59).Value
If hhh = xxx Then
vEingabe = ThisWorkbook.Sheets("test").Range("A" & vZelle).Value
With ext_wb.Sheets("Rep").Columns("B")
Set Reportnummer = .Find(What:=vEingabe, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Reportnummer Is Nothing Then
x = Reportnummer.Row
adate = ThisWorkbook.Sheets("test").Cells(vZelle, 61)
<strong> If IsEmpty(Cells(vZelle, 62).Value) Then
ext_wb.Sheets("Rep").Cells(Reportnummer.Row, 21).Copy
ThisWorkbook.Sheets("test").Cells(vZelle, 62).PasteSpecial xlPasteValues
date_closed = DateDiff("m", adate, Date)
Cells(vZelle, 63).Value = date_closed
End If</strong>
End If
End With
Else: GoTo ExitLoop
End If
Next
ExitLoop:
ext_wb.Close savechanges:=False
Dateiname = Dir()
loc = vZelle
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub