Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Funktion soll 2 Sheets ansprechen

Forumthread: Funktion soll 2 Sheets ansprechen

Funktion soll 2 Sheets ansprechen
25.01.2018 21:21:58
URH
Hallo und guten Abend!
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
Danke im Voraus und Gruß, Uwe
https://www.herber.de/bbs/user/119272.xlsm
Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Funktion soll 2 Sheets ansprechen
25.01.2018 21:59:30
URH
für die Funktion Beschleunigen bin ich gerade fündig geworden und scheinbar funktioniert das auch :)

Function Ausblenden(ByVal iWert As Integer, ByVal iGes As Integer)
Dim i As Integer
Dim SN As String
SN = ActiveSheet.Name
Beschleunigen True
For i = 6 To 371
If iGes = -1 Then
ThisWorkbook.Sheets(SN).Rows(i).Hidden = False
Else
If Month(ThisWorkbook.Sheets(SN).Cells(i, 2).Value)  iWert Then
ThisWorkbook.Sheets(SN).Rows(i).Hidden = True
Else
ThisWorkbook.Sheets(SN).Rows(i).Hidden = False
End If
End If
Next i
Beschleunigen False
End Function
Mit SN = ActiveSheet.Name hole ich mir den Tabellenname, den ich dann bei ThisWorkbook.Sheets(SN) statt der 1 einsetze. So scheint das an der Stelle zumindest für Tabelle 1 und 2 zu funktionieren.
Wie bekomme ich das für Sub WriteVal() hin?
Anzeige
AW: Funktion soll 2 Sheets ansprechen
25.01.2018 22:19:30
URH
Mann, kaum stell ich die Frage und schon purzelt mir die Lösung in den Schoss bzw. auf den Monitor ;)
Für die Sub WriteVal() ist es wohl das "gleiche in grün" :)

Sub WriteVal()
Dim oVal As Variant
Dim oVal2 As Variant
Dim rAC As Range
Dim SN As String
SN = ActiveSheet.Name
Set rAC = Selection
If rAC.Columns.Count = 1 And ActiveSheet.Cells(5, rAC.Column) = "A" Then
oVal = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(SN).Range("A3"), _
Tabelle3.Range("E1:G10"), 2, False)
If IsNumeric(Left(ThisWorkbook.Sheets(SN).Range("A3"), 2)) Then
oVal2 = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(SN).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
Hier war wohl dan doch nur "Tabelle1" jeweils durch ThisWorkbook.Sheets(SN) zu ersetzen.
Wie kann ich nun

Dim SN As String
SN = ActiveSheet.Name

Als Funktion schreiben, so daß ich ggf. in den anderen Funktionen mir diesen Wert holen kann?
Danke und Gruß, Uwe
Hier die aktuelle Version:
https://www.herber.de/bbs/user/119274.xlsm
Anzeige
AW: Funktion soll 2 Sheets ansprechen
26.01.2018 11:07:07
URH
Bei der Sub WriteVal() hab ich mich wohl zu früh gefreut, das hier

oVal = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets(SN).Range("A3"),

funktioniert wohl nicht :(
Hat jemand eine Idee, wie ich das hinbekomme, dass WriteVal für Tabelle 1(Dienstplan A) und Tabelle 2 (Dienstpaln B) funktioniert?
Grüße, Uwe
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige