iki tarih arasında süzme işlemi

[ferhatgurbuz]

Arkadaşlar kolay gelsin. Daha önce aşağıdaki kodu siz değerli arkadaşlara yaptırmıştım. Formda böyle bir örnekler olsada ben bire bir uyarlayamıyorum. Kusura bakmayın.


şimdi iki tarih arasında ver süzmek istiyorum. uyarlayabilirseniz sevinirim. tarihleri aynı yerden alacak












Sheets("Baslama_Tarihi").Range("B2:F250").ClearContents
Dim s1 As Worksheet, s2 As Worksheet, sat As Long, sat2 As Long
Dim hcr As Range
If ComboBox1.Value = "" Then Exit Sub
Set s1 = Sheets("DATA")
Set s2 = Sheets("Baslama_Tarihi")
sat = s1.Cells(65536, "B").End(xlUp).Row
sat2 = s2.Cells(65536, "B").End(xlUp).Row + 1

For Each hcr In s1.Range("E2:E" & sat)
If hcr.Value = CDate(ComboBox1.Value) Then
s2.Range("B" & sat2) = sat2 - 1
s2.Range("B" & sat2 & ":F" & sat2).Value = s1.Range("B" & hcr.Row & ":F" & hcr.Row).Value
sat2 = sat2 + 1
End If
Next
Dim i As Long, Son As Long
Application.ScreenUpdating = False
On Error Resume Next
Son = [B65536].End(3).Row
For i = 2 To Son
Cells(i, "G") = Split(Cells(i, "C"), ".")(1) & _
Application.Rept("a", Split(Cells(i, "L"), ".")(0))
Next i
Range("B2:G" & Son).Sort Range("G2"), xlAscending
Range("G2:G" & Son).ClearContents
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton2_Click()
UserForm2.Show
End Sub



Private Sub UserForm_Initialize()
Set s1 = Sheets("DATA")
For a = 2 To s1.[E65535].End(3).Row
V = 0
mah = Trim(s1.Cells(a, "E"))
For b = 0 To ComboBox1.ListCount - 1
If ComboBox1.List(b) = mah Then
V = 1
GoTo atla
End If
Next


atla:
If V <> 1 Then
ComboBox1.AddItem mah
End If
V = 0
Next
End Sub

 

[mustafa1205]

Örnek dosya ?

 

[ferhatgurbuz]

ek dosya

dosyayı ekledim kusura bakmayın teşekkürler.

 

[ferhatgurbuz]

bu konu hakkında fikri olan yokmu.

 

[halit3]

bu konu hakkında fikri olan yokmu.

G10-G11 hücrelerine ait veri alınacak tarih aralıklarını girerek verileri alabilirsiniz.

 

[ferhatgurbuz]

Sağolun kolay gelsin teşekkürler.

 

[ferhatgurbuz]

Calendar1.Top = ActiveCell.Top hatası

halit hocam bu hücrelere takvim ekleyeyim dedim ama hata veriyor bir türlü bulamadım.Ne yaptıysam olmuyor.

Calendar1.Top = ActiveCell.Top bu hatayı veriyor


Private Sub Calendar1_Click()
ActiveCell.Value = Calendar1.Value
Calendar1.Visible = False
End Sub

Private Sub Worksheet_Activate()
Calendar1.Visible = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.MoveAfterReturn = False
If Target.Address = "$G$10" Then
Exit Sub
ElseIf Target.Address = "$G$" & ActiveCell.Row Then
Calendar1.Visible = True
Calendar1.Top = ActiveCell.Top
End If
End Sub

 

[halit3]

Bunu denermisiniz.

kod:

Dim adres

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
adres = Target.Address
If Target.Address = "$G$10" Or Target.Address = "$G$11" Then
Calendar1.Visible = True
Calendar1.Top = ActiveCell.Top
Else
Calendar1.Visible = False
End If
End Sub


Private Sub Calendar1_Click()
Range(adres).Value = Calendar1.Value
Calendar1.Visible = False
End Sub

 

[ferhatgurbuz]

Hata veriyor hocam. Calendar1.Visible = False yi gösteriyor. Başka sayfayı taşıyorum kitaba o kitaptaki aynı formül çalışıyor ama bu sayfadaki çalışmıyor neden olabilir aceba.

 

[halit3]

Hata veriyor hocam. Calendar1.Visible = False yi gösteriyor. Başka sayfayı taşıyorum kitaba o kitaptaki aynı formül çalışıyor ama bu sayfadaki çalışmıyor neden olabilir aceba.

Çalışmayan dosyayı ekleyin bir bakalım.

 

[ferhatgurbuz]

Halit hocam. iki örnek dosya ekledim. biri siteden indirdiğim bir örnek ve diğeri bende kurulu olan ofisten senin en son yazmış olduğun kodu ikisinede yapıştırdım biri çalışıyor diğeri çalışmıyor çalışmayan benim ofis. Ben mi eksik yapıyorum yoksa ofiste mi sorun var. siteden indirmiş olduğum dosya benim ofisle açılmıyor mu birde benim dosyada microsoft ofis calander control 11.0 yok iken diğerinde var.

benim için bir sürü soru işareti sizi bilmiyorum. Kolay gelsin teşekkür ederim.

asıl uyarlamak istediğim dosya ise sizin 5. mesajda uarladığınız dosya.

 

[halit3]

Halit hocam. iki örnek dosya ekledim. biri siteden indirdiğim bir örnek ve diğeri bende kurulu olan ofisten senin en son yazmış olduğun kodu ikisinede yapıştırdım biri çalışıyor diğeri çalışmıyor çalışmayan benim ofis. Ben mi eksik yapıyorum yoksa ofiste mi sorun var. siteden indirmiş olduğum dosya benim ofisle açılmıyor mu birde benim dosyada microsoft ofis calander control 11.0 yok iken diğerinde var.

benim için bir sürü soru işareti sizi bilmiyorum. Kolay gelsin teşekkür ederim.

asıl uyarlamak istediğim dosya ise sizin 5. mesajda uarladığınız dosya.

Sizin dosyanızda takvim nesnesi olmadığından kod hata veriyor.

Denetim araç kutusunda (Diğer denetimler) -(takvim denetimi 11.0) bul ve onu sayfaya sürükle böylece takvim nesnesi sayfaya gelmiş olacaktır.

Bunu yapamazsanız diğer dosyadaki takvim nesnesini kendi dosyanıza kopyalayıp yapıştırın.

Veya aşağıdaki kodu kullanarak takvim nesnesini sayfaya getirebilirsiniz.

Sub Makro1()
    ActiveSheet.OLEObjects.Add(ClassType:="MSCAL.Calendar.7", Link:=False, _
        DisplayAsIcon:=False, Left:=147.75, Top:=138.75, Width:=339.75, Height _
        :=202.5).Select
    Range("A1").Select
End Sub

 

[ferhatgurbuz]

teşekkürler halit hocam. Allah razı olsun. basit birşey için sizleri yordum. kusura bakmayın

 

[halit3]

teşekkürler halit hocam. Allah razı olsun. basit birşey için sizleri yordum. kusura bakmayın

İyi çalışmalar