Új hozzászólás Aktív témák

• #30905 Delila_1 veterán gdodi #30904

  Új Válasz 2016-03-08 09:50:11 #30905

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz gdodi #30904 üzenetére

  A lenti makróban meg kell adnod a keresendő dátumot, és a sor számát, ahol keresel.

  Ellenőrzi a bevitt értéket. Két sort megjegyzésbe tettem, azokban megadhatod, hogy nem lehet a dátum éve kisebb, mint az idei, ill. nem lehet kisebb a mai dátumnál.

  Sub DatumHelye()
  Dim Kelt As String, oszlop, sor As Long
  
  sor = Application.InputBox("Melyik sorban keressünk?", "Sorszám bekérése", , , , , , 1)
  Kelt = Application.InputBox("Add meg a dátumot!", "Dátum bekérése", , , , , , 2)
  
  'Ellenőrzés
  If Len(Kelt) <> 10 Then GoTo Hiba
  If Mid(Kelt, 5, 1) <> "." Then GoTo Hiba
  If Mid(Kelt, 8, 1) <> "." Then GoTo Hiba
  If Mid(Kelt, 6, 2) > "12" Then GoTo Hiba
  If Right(Kelt, 2) > "31" Then GoTo Hiba
  If Not IsNumeric(Left(Kelt, 4)) Then GoTo Hiba
  If Not IsNumeric(Mid(Kelt, 6, 2)) Then GoTo Hiba
  If Not IsNumeric(Right(Kelt, 2)) Then GoTo Hiba
  'If Left(Kelt,4)*1 < Year(Date) Then Go To Hiba
  'If CDate(Kelt) *1 < Date Then GoTo Hiba
  
  Select Case Mid(Kelt, 6, 2)
  Case "02"
  If Left(Kelt, 4) / 4 <> Int(Left(Kelt, 4) / 4) And Right(Kelt, 2) > 28 Then GoTo Hiba
  Case "04", "06", "09", "11"
  If Right(Kelt, 2) > 30 Then GoTo Hiba
  End Select
  If Left(Kelt, 4) / 4 = Int(Left(Kelt, 4) / 4) And Mid(Kelt, 6, 2) = "02" _
  And Right(Kelt, 2) > 29 Then GoTo Hiba
  
  'Keresés
  oszlop = Application.Match(CDate(Kelt) * 1, Rows(sor), 0)
  If VarType(oszlop) = vbError Then
  MsgBox "Nincs " & Kelt & " dátum a " & sor & ". sorban", vbOKOnly + vbInformation
  Else
  MsgBox "A " & Kelt & " dátum a(z) " & sor & ". sorban, a(z) " & oszlop & ". oszlopban található.", vbOKOnly + vbInformation
  End If
  
  Exit Sub
  
  Hiba:
  MsgBox "Hibás dátum!", vbOKOnly + vbCritical
  End Sub

Új hozzászólás Aktív témák