AW: Zusatz ".Value" erforderlich
27.01.2023 18:45:50
Yal
Hallo Stefan,
Du stellst sehr viele Variablen bereit, die Du gar nicht benutzst. Es kann für Debugging-Zweck sinnvoll sein, lastet aber die Lesbbarkeit aus.
Vermeide, die Range "unqualifiziert" anzusprechen. Ein Range ist immer in einem Blatt. Ohne definiertem Blatt wird der Range immer auf das ActiveSheet gesucht. Nutzt dafür Objekt-Variable vom Typ "Worksheet" oder eine With.
Dein Code lässt wie folgt "bereinigen" ("End Sub" ist nicht klar. Bitte immer kompletten Sub posten):
Type Datei
Ordner As String
isp As String
Link As String
dpList As String
dpt As String
End Type
Sub Aktualisieren()
Dim i, R
Dim pfad As String
Dim pfad1 As String
Dim Dateien(1 To 15) As Datei
Dim wsQ As Worksheet ' Q wie quelle
Dim wsZ As Worksheet ' Z wie Ziel
Dim lastRowZ As Long
Dim lastRowQ As Long
Dim Z As Long
Dim Y As Long
pfad = ThisWorkbook.Path & "\"
pfad1 = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 18)
For i = 1 To 15
With Dateien(i)
.Ordner = Range("Config!C" & i + 4) & Range("Config!D" & i + 4).Value
.isp = Range("Config!B" & i + 4).Value
.Link = Dir(pfad & "*" & .isp & "*.xlsm")
.dpList = Dir(pfad1 & "14 Software\Datenpunktlisten\" & .Ordner & "*" & .isp & "*.xlsm")
.dpt = Range("Config!E" & i + 4).Value
End With
Next
'Anzeigen unterdrücken
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'On Error GoTo Fehler1
If Dateien(1).isp > "" Then
Set wsQ = Workbooks.Open(pfad & Dateien(1).Link).Worksheets(1)
Set wsZ = Workbooks("Statistik.xlsm").ActiveSheet
wsQ.Activate
i = 0
For Each R In Split("provBeschr KabPos FeldgMont AnschlFeld FeldgBeschr KabBeschrVon KabBeschrNach AufmaßProz")
wsZ.Cells(i + 7, "C") = wsQ.Range(R).Value
i = i + 1
Next
wsQ.Close SaveChanges:=False
If Dateien(1).dpt = "ja" Then
Set wsQ = Workbooks.Open(pfad1 & "14 Software\Datenpunktlisten\" & Dateien(2).Ordner & Dateien(1).dpList).Worksheets(1) 'Dateien(2) & (1)? Sicher?
wsQ.Activate
With Workbooks("Statistik.xlsm").Worksheets("Statistik")
.Range("M7").Value = wsQ.Range("DPLproz").Value
.Range("N7") = wsQ.Range("DPLinsg").Value
.Range("O7") = wsQ.Range("DPLfertig").Value
End With
Set wsZ = Workbooks("Statistik.xlsm").Worksheets("offene Punkttests")
lastRowZ = wsZ.Cells(Rows.Count, 2).End(xlUp).Row
lastRowQ = wsQ.Cells(Rows.Count, 2).End(xlUp).Row
For Z = lastRowZ To 500
For Y = 50 To lastRowQ
If wsQ.Cells(Y, wsQ.Range("standort").Column) > "" Then
wsZ.Cells(Z, wsZ.Range("PktEinf").Column) = wsQ.Cells(Y, wsQ.Range("DPLaks").Column).Value
End If
Next Y
Next Z
wsQ.Close SaveChanges:=False
End If
End If
GoTo List2
Fehler1:
'MsgBox "Fehler bei Abfrage von ISP in Zeile 1!"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
VG
Yal