AW: Unverständliche Laufzeitfehler
27.06.2012 14:22:26
Markus
Hallo Rudi,
echt? Das ist Code-Zeile 13: "Dim intCount_3 As Integer" . Was stimmt damit nicht?
Spass beiseite: Ich verstehe deinen Kommentar so, dass dir der Code fehlt. Den reiche ich hiermit gerne nach.
Viele Grüße
Markus
Sub genValDocumentation()
Dim wb As Workbook
Dim wsTarget As Worksheet
Dim wsSource As Worksheet
Dim rngErg As Variant
Dim rngErg2 As Variant
Dim firstAddress As Variant
Dim rngValArea As Range
Dim intFirstRowOfVal As Integer
Dim intLastRowOfVal As Integer
Dim intTrgtRowCount As Integer
Dim intCount_3 As Integer
Dim strFrml As String
Const cstTrgtStartZeile = 3
'Spalten auf dem Zielblatt
Const strTrgtLvl = "A"
Const strTrgtTecName = "B"
Const strTrgtDscr = "C"
Const strTrgtFrml = "D"
Set wb = ThisWorkbook
Set wsTarget = wb.Worksheets("Target")
Set wsSource = wb.Worksheets("Source")
'Ermitteln der letzten gefüllten Zelle --> Zeile auf dem Quellblatt
wsSource.Activate
loLetzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'Validierungen suchen
intTrgtRowCount = cstTrgtStartZeile
With wsSource.Range("A1:AZ" & loLetzte)
Set rngErg = .Find("Details", LookIn:=xlValues, lookat:=xlWhole)
If Not rngErg Is Nothing Then
firstAddress = rngErg.Row
Do
intFirstRowOfVal = rngErg.Row - 2
'Set rngErg = Nothing
'Ermittle letzte Zeile der Validierung
Set rngErg2 = wsSource.Range("A" & intFirstRowOfVal + 3 & ":AZ" & loLetzte).Find(" _
Details", LookIn:=xlValues, lookat:=xlWhole)
If Not rngErg2 Is Nothing Then
intLastRowOfVal = rngErg2.Row - 3
Else
intLastRowOfVal = loLetzte
End If
Set rngErg2 = Nothing
'Zuweisen der Range für die aktuelle Validierung
Set rngValArea = wsSource.Range("A" & intFirstRowOfVal & ":AZ" & intLastRowOfVal)
'Validierungsdetails auslesen
''Kopfzeile
wsTarget.Range(strTrgtTecName & intTrgtRowCount) = rngValArea.Cells(1, 1).End( _
xlToRight).Value
wsTarget.Range(strTrgtDscr & intTrgtRowCount) = rngValArea.Cells(1, rngValArea. _
Cells(1, 1).End(xlToRight).Column).End(xlToRight).Value
'''Formel ermitteln
Set rngErg2 = rngValArea.Find("Formula String", LookIn:=xlValues, lookat:=xlWhole)
If Not rngErg2 Is Nothing Then
intCount_3 = rngErg2.Row + 2
strSrcFrml = rngErg2.Column
End If
Set rngErg2 = Nothing
strFrml = ""
On Error Resume Next
Do While wsSource.Cells(intCount_3, strSrcFrml) ""
strFrml = strFrml & " " & wsSource.Cells(intCount_3, strSrcFrml)
intCount_3 = intCount_3 + 1
Loop
On Error GoTo 0
wsTarget.Range(strTrgtFrml & intTrgtRowCount) = strFrml
intTrgtRowCount = intTrgtRowCount + 1
Set rngErg = .Find("Details", After:=rngErg, LookIn:=xlValues, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Loop While Not rngErg.Row = firstAddress
End If
End With
Set wb = Nothing
Set wsTarget = Nothing
Set wsSource = Nothing
Set rngErg = Nothing
Set rngErg2 = Nothing
End Sub