VBA-Code Anpassen

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim Zeile As Long Select Case Target.Address Case "$A$8", "$A$23", "$A$36" Zeile = 8 Case "$A$9", "$A$24", "$A$37" Zeile = 9 Case "$A$10", "$A$25", "$A$38" Zeile = 10 Case "$A$11", "$A$26", "$A$39" Zeile = 11 Case "$A$12", "$A$27", "$A$40" Zeile = 12 Case "$A$13", "$A$28", "$A$41" Zeile = 13 Case "$A$14", "$A$29", "$A$42" Zeile = 14 Case Else GoTo zumEnde End Select zumEnde: [a1].Select End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim Zeile As Long Dim a As Integer For a = 8 To 70 Select Case Target.Address Case Cells(a, 1), Cells(a + 15, 1), Cells(a + 28, 1) Zeile = a Case Else GoTo zumEnde End Select next a zumEnde: [a1].Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim Zeile As Long, a As Long For a = 8 To 70 Select Case Target.Address Case Cells(a, 1).Address, Cells(a + 15, 1).Address, Cells(a + 28, 1).Address Zeile = a Exit For End Select Next a MsgBox Zeile ' Was machst du mit der Variablen "Zeile"? [a1].Select ' Wozu? End Sub

Hallo Erich,
ersmal vielen dank für deine schneller Reaktion. ich probiert gleich, den Code!!
andersmal gebe ich dir Recht.
den Code ist eine Teil einen gesamte Code, habe ich nur rausgenommen wo ich Problem habe. sonst wird unübersichtlich alle auf den Forum zustellen.
noch mal herzlich dank
Maiks
falls das dir interessiert könnte, hier ist die gesamte Code:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim Mname As String
Dim txt As String
Dim Grund As String
Dim Beginn As Date
Dim Ende As Date
Dim Zeile As Long, dat As Long, Anzahl As Long, gAnzahl As Long
Dim x As Byte, y As Byte
Select Case Target.Address
Case "$A$8", "$A$23", "$A$36"
Zeile = 8
Case "$A$9", "$A$24", "$A$37"
Zeile = 9
Case "$A$10", "$A$25", "$A$38"
Zeile = 10
Case "$A$11", "$A$26", "$A$39"
Zeile = 11
Case "$A$12", "$A$27", "$A$40"
Zeile = 12
Case "$A$13", "$A$28", "$A$41"
Zeile = 13
Case "$A$14", "$A$29", "$A$42"
Zeile = 14
Case Else
GoTo zumEnde
End Select
dat = 5      ' Datumszeile
Mname = Cells(Zeile, 1)
Beginn = 0  ' Startwert Null
Ende = 0
Anzahl = 0
Grund = ""
txt = Mname & " hat vom: " & Chr(13) & Chr$(13)
' Tage ermitteln
For y = 1 To 2
For x = 2 To 185
If Cells(Zeile, x) = Sheets("Urlaub").[K2] And Cells(Zeile, x - 1)  Sheets("Urlaub").[K2]  _
Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K3] And Cells(Zeile, x - 1)  Sheets("Urlaub").[K3]  _
Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K4] And Cells(Zeile, x - 1)  Sheets("Urlaub").[K4]  _
Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K5] And Cells(Zeile, x - 1)  Sheets("Urlaub").[K5]  _
Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K6] And Cells(Zeile, x - 1)  Sheets("Urlaub").[K6]  _
Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K7] And Cells(Zeile, x - 1)  Sheets("Urlaub").[K7]  _
Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K8] And Cells(Zeile, x - 1)  Sheets("Urlaub").[K8]  _
Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K9] And Cells(Zeile, x - 1)  Sheets("Urlaub").[K9]  _
Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K10] And Cells(Zeile, x - 1)  Sheets("Urlaub").[ _
K10] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K11] And Cells(Zeile, x - 1)  Sheets("Urlaub").[ _
K11] Then Beginn = Cells(dat, x)
' Zeitraumende ermitteln
If Cells(Zeile, x) = Sheets("Urlaub").[K2] And Cells(Zeile, x + 1)  Sheets("Urlaub").[K2]  _
Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K3] And Cells(Zeile, x + 1)  Sheets("Urlaub").[K3]  _
Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K4] And Cells(Zeile, x + 1)  Sheets("Urlaub").[K4]  _
Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K5] And Cells(Zeile, x + 1)  Sheets("Urlaub").[K5]  _
Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K6] And Cells(Zeile, x + 1)  Sheets("Urlaub").[K6]  _
Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K7] And Cells(Zeile, x + 1)  Sheets("Urlaub").[K7]  _
Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K8] And Cells(Zeile, x + 1)  Sheets("Urlaub").[K8]  _
Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K9] And Cells(Zeile, x + 1)  Sheets("Urlaub").[K9]  _
Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K10] And Cells(Zeile, x + 1)  Sheets("Urlaub").[ _
K10] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K11] And Cells(Zeile, x + 1)  Sheets("Urlaub").[ _
K11] Then Ende = Cells(dat, x)
' wenn Anfang und Ende ermittelt Text fortschreiben
If Beginn  0 And Ende  0 Then
If Cells(Zeile, x) = Sheets("Urlaub").[K2] Then Grund = Sheets("Urlaub").[L2]
If Cells(Zeile, x) = Sheets("Urlaub").[K3] Then Grund = Sheets("Urlaub").[L3]
If Cells(Zeile, x) = Sheets("Urlaub").[K4] Then Grund = Sheets("Urlaub").[L4]
If Cells(Zeile, x) = Sheets("Urlaub").[K5] Then Grund = Sheets("Urlaub").[L5]
If Cells(Zeile, x) = Sheets("Urlaub").[K6] Then Grund = Sheets("Urlaub").[L6]
If Cells(Zeile, x) = Sheets("Urlaub").[K7] Then Grund = Sheets("Urlaub").[L7]
If Cells(Zeile, x) = Sheets("Urlaub").[K8] Then Grund = Sheets("Urlaub").[L8]
If Cells(Zeile, x) = Sheets("Urlaub").[K9] Then Grund = Sheets("Urlaub").[L9]
If Cells(Zeile, x) = Sheets("Urlaub").[K10] Then Grund = Sheets("Urlaub").[L10]
If Cells(Zeile, x) = Sheets("Urlaub").[K11] Then Grund = Sheets("Urlaub").[L11]
Anzahl = DateDiff("d", Beginn, Ende) + 1
gAnzahl = gAnzahl + Anzahl
txt = txt & " " & Beginn & "  bis  " & Ende & "  =  " & Anzahl & "  " & Grund & "  " &  _
Chr(13) '& Chr(13)
Beginn = 0  ' zurückstellen
Ende = 0
Anzahl = 0
Grund = ""
End If
Next x
Zeile = Zeile + 15
dat = dat + 15
Next y
' Ausgabe
MsgBox txt & Chr(13) & "   " & gAnzahl & " Tage genommen/verplant.", , "Urlaubsübersicht"
zumEnde:
[a1].Select
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim Zeile As Long, a As Long If Target.Column 1 Then Exit Sub For a = 8 To 70 Select Case Target.Row Case a, a + 15, a + 28 Zeile = a Exit For End Select Next a MsgBox Zeile End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread