gctools/excel/dimension.xls.vb

Private Function EbenenFuellen()
    Dim headRow1, headRowN, headCol1, headColN, dataRow1, dataRowN, dataCol1, dataColN As Integer
    
    headCol1 = 1
    If Cells(9, 1).Value Like "*Schicht*" Then
        headRow1 = 10
    Else
        headRow1 = 8
    End If
    
    dataRow1 = headRow1
    Do
        dataRow1 = dataRow1 + 1
    Loop Until Cells(dataRow1, headCol1).Value <> ""
    headRowN = dataRow1 - 1
    
    dataCol1 = headCol1
    Do
        dataCol1 = dataCol1 + 1
    Loop Until IsNumeric(Cells(dataRow1, dataCol1).Value)
    headColN = dataCol1 - 1
        
    dataRowN = dataRow1
    Do While Cells(dataRowN + 1, dataCol1).Value <> ""
        dataRowN = dataRowN + 1
    Loop

    dataColN = dataCol1
    Do While Cells(dataRow1, dataColN + 1).Value <> ""
        dataColN = dataColN + 1
    Loop
    
    Dim c, r As Integer
    Dim txt As String
        
    Rem Zeilen füllen
    For c = headCol1 To headColN
        txt = ""
        For r = dataRow1 To dataRowN
            If Cells(r, c).Value = "" Then
                If c > headCol1 And r > dataRow1 Then
                    If Cells(r, c - 1).Value <> Cells(r - 1, c - 1).Value Then
                        txt = Cells(r, c - 1).Value
                    End If
                End If
                Cells(r, c).Value = txt
            Else
                txt = Cells(r, c).Value
            End If
        Next r
    Next c
    
    Rem Spalten füllen
    For r = headRow1 To headRowN
        txt = ""
        For c = dataCol1 To dataColN
            If Cells(r, c).Value = "" Then
                If c > dataCol1 And r > headRow1 Then
                    If Cells(r - 1, c).Value <> Cells(r - 1, c - 1).Value Then
                        txt = Cells(r - 1, c).Value
                    End If
                End If
                Cells(r, c).Value = txt
            Else
                txt = Cells(r, c).Value
            End If
        Next c
    Next r
    
End Function


Sub Workflow(datei As String)
    Dim Current As Worksheet
        
    Workbooks.Open Filename:=datei
    For Each Current In Worksheets
        Current.Select
        EbenenFuellen
    Next
    
    ActiveWorkbook.Save
    Application.Quit
End Sub



Sub Makro1()
    Workflow ActiveWorkbook.Path + "\FIBU_Gebrauchtwagen.xls"
End Sub