Funktion soll 2 Sheets ansprechen
25.01.2018 21:21:58
URH
Im der beiliegenden Exceldatei befindet sich derzeit ein bzw. zwei Makros die ursprünglich für Tabelle 1 (Dienstplan A)gedacht waren.
Nun gibt es aus gg. Anlass eine Tabelle 2 (Dienstplan B) in der sich exakt das gleiche befindet.
Wie muß ich den Code anpassen, damit er für Tabelle 1 und Tabelle 2 funktioniert?
Ich hatte es u.a mal mit ThisWorkbook.ActiveWorksheet... statt ThisWorkbook.Sheets(1) versucht, bin daran aber ziemlich kläglich gescheitert.
Function Ausblenden(ByVal iWert As Integer, ByVal iGes As Integer)
Dim i As Integer
Beschleunigen True
For i = 6 To 371
If iGes = -1 Then
ThisWorkbook.Sheets(1).Rows(i).Hidden = False
Else
If Month(ThisWorkbook.Sheets(1).Cells(i, 2).Value) iWert Then
ThisWorkbook.Sheets(1).Rows(i).Hidden = True
Else
ThisWorkbook.Sheets(1).Rows(i).Hidden = False
End If
End If
Next i
Beschleunigen False
End Function
Function Beschleunigen(ByVal BGesetzt As Boolean)
BGesetzt = Not BGesetzt
With Application
.ScreenUpdating = BGesetzt
.AskToUpdateLinks = BGesetzt
.EnableEvents = BGesetzt
If BGesetzt Then
.Calculation = xlCalculationAutomatic
Else
.Calculation = xlCalculationManual
End If
.DisplayAlerts = BGesetzt
End With
End Function
Sub WriteVal()
Dim oVal As Variant
Dim oVal2 As Variant
Dim rAC As Range
Set rAC = Selection
If rAC.Columns.Count = 1 And ActiveSheet.Cells(5, rAC.Column) = "A" Then
oVal = Application.WorksheetFunction.VLookup(Tabelle1.Range("A3"), _
Tabelle3.Range("E1:G10"), 2, False)
If IsNumeric(Left(Tabelle1.Range("A3"), 2)) Then
oVal2 = Application.WorksheetFunction.VLookup(Tabelle1.Range("A3"), _
Tabelle3.Range("E1:G10"), 3, False)
rAC.Value = oVal
rAC.Offset(0, 1).Value = oVal2
If Not rAC.Offset(0, 2).HasFormula Then
rAC.Offset(0, 2).FormulaR1C1 = "=RC[-1]-RC[-2]"
End If
Else
rAC.Offset(0, 2).Value = oVal
rAC.ClearContents
rAC.Offset(0, 1).ClearContents
End If
Else
MsgBox "Für Eingabe von Anfangszeiten nur [A]-Spalten selektieren!", _
vbOKOnly, "Eingabebereich prüfen"
End If
Set rAC = Nothing
End Sub
https://www.herber.de/bbs/user/119272.xlsm