• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Olmayan tarihleri bulma

N

nadirornek

Katılım
14 Haziran 2006
Mesajlar
575
Merhaba Arkadaşlar

A sutununda 01.01.2012-31.12.2012 tarih aralığı var.
Bu aralıktaki olmayan tarihleri dosyayı açtığım zaman MsgBox olarak alabilirmiyiz.Teşekkürler.
 

Ekli dosyalar

nadirornek' Alıntı:
Merhaba Arkadaşlar

A sutununda 01.01.2012-31.12.2012 tarih aralığı var.
Bu aralıktaki olmayan tarihleri dosyayı açtığım zaman MsgBox olarak alabilirmiyiz.Teşekkürler.
Genişletmek için tıkla ...

Merhaba
Kitabınızın Thisworkbook bölümüne
Kod: 
Option Explicit
Private Sub Workbook_Open()
'Konu       :   Olmayan Tarihleri Msgbox ile Bildir
'Mail       :   m.batu.1967@gmail.com
'Coder By   :   asi_kral_1967
Dim asi, kral
For asi = 1 To 365
If WorksheetFunction.CountIf(Range("A2:A" & Rows.Count), _
DateSerial(Year(Range("A2")), 1, asi)) < 1 Then
If kral = Empty Then
kral = kral & DateSerial(Year(Range("A2")), 1, asi)
Else
kral = kral & vbLf _
& DateSerial(Year(Range("A2")), 1, asi)
End If
End If
Next
MsgBox kral
End Sub
Bu kodu kopyalayın ve kitabı kaydedip kapatın.
Eki inceleyiniz
 

Ekli dosyalar

Teşekkürler güzel bir çalışma olaçak .Tarihler ekranın altına kayıyor.uzun oldığu için görünmüyor.Bunu yan yana yazdırabilirmiyiz.Tarihleri gün görüneçek şekilde değiştirebilirmiyiz.
örnek 29 şubat 2012 Çarşamba şeklinde.
 
nadirornek' Alıntı:
Teşekkürler güzel bir çalışma olaçak .Tarihler ekranın altına kayıyor.uzun oldığu için görünmüyor.Bunu yan yana yazdırabilirmiyiz.Tarihleri gün görüneçek şekilde değiştirebilirmiyiz.
örnek 29 şubat 2012 Çarşamba şeklinde.
Genişletmek için tıkla ...

Sorunun ne olduğunu anlamadım lütfen tekrar anlatır mısınız_?
 
Tarihler altlata sıralandığı için uzun oluyor.MsgBox'u içeriğini tek sutun değilde ekranda gözükeçek şekilde sutunlar halinde tarihler 2 veya 3 sutun olabilirmi.
 
Tarih formatını örneğin 29.02.2012 29 Şubat 2012 Çarşamba şeklinde değiştirebilirmiyiz.
 
nadirornek' Alıntı:
Tarihler altlata sıralandığı için uzun oluyor.MsgBox'u içeriğini tek sutun değilde ekranda gözükeçek şekilde sutunlar halinde tarihler 2 veya 3 sutun olabilirmi.
Genişletmek için tıkla ...

Merhaba
Kodu bununla değişir misiniz_?
Kod: 
Option Explicit
Private Sub Workbook_Open()
'Konu       :   Olmayan Tarihleri Msgbox ile Bildir
'Mail       :   m.batu.1967@gmail.com
'Coder By   :   asi_kral_1967
Dim asi, kral
Dim a As New Collection, b, c
For asi = 1 To 365
If WorksheetFunction.CountIf(Range("A2:A" & Rows.Count), _
DateSerial(Year(Range("A2")), 1, asi)) < 1 Then
a.Add DateSerial(Year(Range("A2")), 1, asi), CStr( _
DateSerial(Year(Range("A2")), 1, asi))
End If
Next
For Each b In a
If kral = Empty Then
kral = kral & CDate(b) & " " & CDate(b + 1) & " " & CDate(b + 2)
Else
kral = kral & vbLf _
& CDate(b) & " " & CDate(b + 1) & " " & CDate(b + 2)
b = b + 4
End If
Next
MsgBox kral
End Sub
Dosya Ekte
 

Ekli dosyalar

Sonradan farkettim 09.01.2012 tarihini gösteriyor normalde göstermemesi gerekiyor.Var olan tarihleride gösteriyor.
 
Kod üzerinde bir tam yıl değilde benim elle gireceğim tarih aralığında olabilirmi?
A sutununda bu tarihle bu tarih aralığında olmayanları göster olabilirmi o zaman kısa görüntü alabiliriz.
 
nadirornek' Alıntı:
Sonradan farkettim 09.01.2012 tarihini gösteriyor normalde göstermemesi gerekiyor.Var olan tarihleride gösteriyor.
Genişletmek için tıkla ...

Merhaba
Bu hatayı çözdüm
Kod: 
Option Explicit
Private Sub Workbook_Open()
'Konu       :   Olmayan Tarihleri Msgbox ile Bildir
'Mail       :   m.batu.1967@gmail.com
'Coder By   :   asi_kral_1967
Dim asi, kral
Dim a As New Collection, b, c
b = 2
For asi = 1 To 365
If WorksheetFunction.CountIf(Range("A2:A" & Rows.Count), _
DateSerial(Year(Range("A2")), 1, asi)) < 1 Then
a.Add DateSerial(Year(Range("A2")), 1, asi), CStr( _
DateSerial(Year(Range("A2")), 1, asi))
End If
Next
c = 1
For Each b In a
If c = 1 Then
c = c + 1
kral = kral & b & " "
ElseIf c = 2 Then
c = c + 1
kral = kral & b & " "
ElseIf c = 3 Then
c = c + 1
kral = kral & b & " "
ElseIf c = 4 Then
c = 1
kral = kral & vbLf
End If
Next
MsgBox kral, vbInformation, "asi_kral_1967"
End Sub
Bu kodu kullanınız.
 
Son düzenleme:
nadirornek' Alıntı:
Kod üzerinde bir tam yıl değilde benim elle gireceğim tarih aralığında olabilirmi?
A sutununda bu tarihle bu tarih aralığında olmayanları göster olabilirmi o zaman kısa görüntü alabiliriz.
Genişletmek için tıkla ...

Merhaba
Bunun içinde kodu
Kod: 
Option Explicit
Private Sub Workbook_Open()
'Konu       :   Belirli Tarih Arasında Olmayan Tarihleri Msgbox ile Bildir
'Mail       :   m.batu.1967@gmail.com
'Coder By   :   asi_kral_1967
Dim asi, kral, kral1, kral2
Dim a As New Collection, b, c
kral1 = InputBox("İlk Tarihi Giriniz", "Tarih Girişi")
If kral1 = Empty Then Exit Sub
kral2 = InputBox("Son Tarihi Giriniz", "Tarih Girişi")
If kral2 = Empty Then Exit Sub
If CDate(kral1) > CDate(kral2) Then
MsgBox "Hata Son Tarih İlk Tarihten Küçük Olmalı", vbCritical, "asi_kral_1967"
Exit Sub
End If
On Error Resume Next
For asi = 1 To CDate(kral2) - CDate(kral1)
If WorksheetFunction.CountIf(Range("A2:A" & Rows.Count), _
DateSerial(Year(CDate(kral1)), Month(CDate(kral1)), Day(CDate(kral1)))) < 1 Then
a.Add DateSerial(Year(CDate(kral1)), Month(CDate(kral1)), Day(CDate(kral1))), CStr( _
DateSerial(Year(CDate(kral1)), Month(CDate(kral1)), Day(CDate(kral1))))
End If
If WorksheetFunction.CountIf(Range("A2:A" & Rows.Count), _
DateSerial(Year(CDate(kral1)), Month(CDate(kral1)), Day(CDate(kral1)) + asi)) < 1 Then
a.Add DateSerial(Year(CDate(kral1)), Month(CDate(kral1)), Day(CDate(kral1)) + asi), CStr( _
DateSerial(Year(CDate(kral1)), Month(CDate(kral1)), Day(CDate(kral1)) + asi - 1))
End If
Next
c = 1
For Each b In a
If c = 1 Then
c = c + 1
kral = kral & b & " "
ElseIf c = 2 Then
c = c + 1
kral = kral & b & " "
ElseIf c = 3 Then
c = c + 1
kral = kral & b & " "
ElseIf c = 4 Then
c = 1
kral = kral & vbLf
End If
Next
MsgBox kral, vbInformation, "asi_kral_1967"
End Sub
Bununla değiştirin.
 
Merhaba,

Alternatif olsun.

Kod: 
Sub Listele()
 
    Dim i As Date, c As Range, msj As String
    
    For i = "01.01.2012" To "31.12.2012"
        Set c = Range("A:A").Find(i, , xlValues, xlWhole)
        If c Is Nothing Then
            msj = msj & Chr(10) & i
        End If
    Next i
            
    MsgBox msj, , "excel.web.tr"
 
End Sub
.
 
Asi Kral'a ve Ömer Bey'e emeklerinden dolayı teşekkür ederim.Güzel bir kısa yol çalışmam oldu.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst