listbox ta bir sutundaki tarihi/tarihleri iki textbox ile süzme

Katılım
16 Aralık 2010
Mesajlar
4
Excel Vers. ve Dili
excel 2007
Merhabalar, Araç Takip programı yapmaya çalışıyorum sonunada geldim. ancak tarih ile listbox ta süzme yapamadım.
excel sayfa adı =liste
tarih sütunu = "E" sütunu
Textbox1 ile Textbox2 tarih girip CommandButton1 'e tıkladığımda Listboxta sadece seçilen raih aralığının listenme kodu için yardım lütfen.
bir de diğer comboboxlar ile diğer kriterlerle süzdüğümde Listbox ta tarih görünümü değişiyor. yardımlarınız için şimdiden teşekkürler.
Kod:
Private Sub ComboBox1_Change()
Dim k As Range, adrs As String, j As Byte, a As Long, myarr()
ReDim myarr(1 To 12, 1 To 1)
With Worksheets("liste")
Me.ListBox1.RowSource = vbNullString
If .FilterMode Then .ShowAllData
Set k = .Range("A1:A65536").Find(ComboBox1.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 12, 1 To a)
For j = 1 To 12
myarr(j, a) = .Cells(k.Row, j).Value
Next j
Set k = .Range("A1:A65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox1.Column = myarr
End If
End With
End Sub
Private Sub ComboBox2_Change()
Dim k As Range, adrs As String, j As Byte, a As Long, myarr()
ReDim myarr(1 To 12, 1 To 1)
With Worksheets("liste")
Me.ListBox1.RowSource = vbNullString
If .FilterMode Then .ShowAllData
Set k = .Range("B1:B65536").Find(ComboBox2.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 12, 1 To a)
For j = 1 To 12
myarr(j, a) = .Cells(k.Row, j).Value
Next j
Set k = .Range("B1:B65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox1.Column = myarr
End If
End With
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Set aktif_txt = Me.TextBox1
Call takvim_cagir
End Sub
Private Sub TextBox2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Set aktif_txt = Me.TextBox2
Call takvim_cagir
End Sub

Private Sub UserForm_Initialize()
ComboBox1 = 1
ComboBox1 = Empty
ListBox1.RowSource = "liste!A1:L11"
ListBox1.ColumnCount = 12
ListBox1.ColumnWidths = "100;50;50;50;50;50;50;50;50;50;50,50" 'lisbox'taki sütunların genişliği
ListBox1.ColumnHeads = False
Dim S1 As Worksheet
Set S1 = Sheets("kurum")
ComboBox1.RowSource = "kurum!A1:A" & S1.Range("A" & Rows.Count).End(xlUp).Row
Set S1 = Sheets("araç")
ComboBox2.RowSource = "araç!B1:B" & S1.Range("B" & Rows.Count).End(xlUp).Row
End Sub
Userformdaki mevcut kodlarım;
 
Katılım
16 Aralık 2010
Mesajlar
4
Excel Vers. ve Dili
excel 2007
Sorunuzu kendi hazırladığınız bir "örnek" excel dosyası ekleyerek sorarsanız, daha hızlı ve doğru cevaplar bulabilirsiniz.
Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz:
https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/
bakınız.
Teşekkür ederim.
örnek dosyam
https://drive.google.com/open?id=1dUYVSZrTljlLShBt1AV3T2l2SOL0O2iL
Merhabalar, Araç Takip programı yapmaya çalışıyorum sonunada geldim. ancak tarih ile listbox ta süzme yapamadım.
excel sayfa adı =liste
tarih sütunu = "E" sütunu
Textbox1 ile Textbox2 tarih girip CommandButton1 'e tıkladığımda Listboxta sadece seçilen raih aralığının listenme kodu için yardım lütfen.
bir de diğer comboboxlar ile diğer kriterlerle süzdüğümde Listbox ta tarih görünümü değişiyor. yardımlarınız için şimdiden teşekkürler.
Merhabalar, Araç Takip programı yapmaya çalışıyorum sonunada geldim. ancak tarih ile listbox ta süzme yapamadım.
excel sayfa adı =liste
tarih sütunu = "E" sütunu
Textbox1 ile Textbox2 tarih girip CommandButton1 'e tıkladığımda Listboxta sadece seçilen tarih aralığının listelennme kodu için yardım lütfen.
bir de diğer comboboxlar ile diğer kriterler ile süzdüğümde Listbox ta tarih görünümü değişiyor. yardımlarınız için şimdiden teşekkürler.
 
Son düzenleme:
Katılım
16 Aralık 2010
Mesajlar
4
Excel Vers. ve Dili
excel 2007
ilginiz için teşekkür ederim.
özür dilerim kullandığım sürüm ( excel 2007 )
dosyayı açarken hata verdi.
aşağıda ki şekilde Compile error hatası
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type

Private Sub UserForm_Initialize()

Dim lngCurPos As POINTAPI
GetCursorPos lngCurPos

Takvim.Top = lngCurPos.y * 0.75
Takvim.Left = lngCurPos.x * 0.75

ReDim Preserve gunler(43)
ReDim Preserve scrl_bar(2)
For i = 1 To 42
Set gunler(i).gunler = Me.Controls("Label" & i)
Next
Set gunler(43).gunler = Me.bugün

For j = 1 To 2
Set scrl_bar(j).scrl_bar = Me.Controls("ScrollBar" & j)
Next

ScrollBar1 = 0
ScrollBar1.Max = Year(bitis_tarih) - Year(baslangic_tarih)


ScrollBar2.Min = 1
ScrollBar2.Max = 12 ' 1 yıldaki ay sayısıdır
ScrollBar2 = 1
Me.bugün = Format(Now, "dd.mm.yyyy")
takvim_durum = True
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
takvim_durum = False
End Sub
 
Son düzenleme:

turist

Destek Ekibi
Destek Ekibi
Katılım
18 Kasım 2009
Mesajlar
5,102
Excel Vers. ve Dili
2013 64Bit
English
Sadece PtrSafe 'i silin.
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
olarak yazın.
 
Katılım
16 Aralık 2010
Mesajlar
4
Excel Vers. ve Dili
excel 2007
Sadece PtrSafe 'i silin.
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
olarak yazın.
Yardımınız için çok teşekkür ederim. PtrSafe silince mükemmel çalıştı.
 
Üst