Re: Fehlende Funktionalität (Gültigkeit - Liste)
04.04.2003 12:24:45
Christian
Hi, sorry hätte ich direkt mitteilen sollen.
Die Zellen die Gültigkeit (Liste) haben sind D4 und E4 die dazugehörigen Daten stehen ind D13:D24 und E13:E24. Durch das Makro wird keine dieser Zellen angesprochen.
Hier der Code, der aus einem Modul kommt und über "Diese Arbeitsmappe" bei Workbook_Open mit Call HideCol und Call CopyFormula aufgerufen wird:
Sub HideCol()
Const rowSearch = 22
Dim shtInput As Worksheet
Dim a As Integer
Set shtInput = ActiveWorkbook.Worksheets("Input Current Week")
Application.ScreenUpdating = False
shtInput.Calculate
For a = 15 To 200
If shtInput.Cells(rowSearch, a) = True Then
shtInput.Columns(a).Hidden = False
Else
shtInput.Columns(a).Hidden = True
End If
Next a
End Sub
'--
Sub CopyFormula()
Application.ScreenUpdating = False
Dim c As Integer
Set shtInput = ActiveWorkbook.Worksheets("Input Current Week")
lastcol = Cells(20, Columns.Count).End(xlToLeft).Column
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
For c = 17 To lastcol
If Right(Cells(20, c), Len(Cells(20, c)) + 1) = "" Then
Cells(30, c).FormulaLocal = ""
Else
Cells(30, c).ClearContents
Cells(30, c).NumberFormat = General
Cells(30, c).FormulaLocal = "=" & Right(Cells(20, c), Len(Cells(20, c)) + 1)
End If
Next c
Range(Cells(30, 17), Cells(30, lastcol)).Select
Selection.AutoFill Destination:=Range(Cells(30, 17), Cells(lastrow, lastcol)), Type:=xlFillDefault
shtInput.Calculate
Range("Q30").Select
Application.ScreenUpdating = True
End Sub