acebeci
Altın Üye
- Katılım
- 25 Ağustos 2007
- Mesajlar
- 326
- Excel Vers. ve Dili
- ofis excel 2010 türkçe
- Altın Üyelik Bitiş Tarihi
- 03-11-2026
Çok kıymetli arkadaşlar aşağıdaki kodlarla iki tarih aralığında raporlama yapıyorum eğer o gün boşsa ve ben boş olmasına rağmen raporla tuşuna basarsam(yanlışlıkla) ekteki hatayı veriyor.Bu hatanın önüne nasıl geçebiliriz acaba
HATA KODU EKTE
Private Sub CommandButton1_Click() 'Sorgula
Dim HaricSayfalar() As Variant, son_tarih As Date
HaricSayfalar = Array("YAZDIR", "CARİ", "RAPOR", "LİSTE", "ŞABLON")
ListBox1.Clear
If IsDate(DTPicker1) = False And DTPicker1 <> "Tümü" Then
MsgBox "İlk Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If DTPicker1 <> "Tümü" Then Tarih = CDate(DTPicker1)
If IsDate(DTPicker2) = False And DTPicker2 <> "Tümü" Then
MsgBox "Son Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If DTPicker2 <> "Tümü" Then son_tarih = CDate(DTPicker2)
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 4 To sh.Cells(65536, 2).End(xlUp).Row
If DTPicker1.Value = "Tümü" Or DTPicker2.Value = "Tümü" Or sh.Cells(i, 2) >= Tarih _
And sh.Cells(i, 2) <= son_tarih Then
If sh.Cells(i, 3) = ComboBox2 Or ComboBox2 = "Tümü" Then
If sh.Cells(i, 4) = ComboBox3 Or ComboBox3 = "Tümü" Then
If sh.Cells(i, 5) = ComboBox4 Or ComboBox4 = "Tümü" Then
If sh.Cells(i, 9) = ComboBox6 Or ComboBox6 = "Tümü" Then
If sh.Cells(i, 17) = ComboBox7 Or ComboBox7 = "Tümü" Then
If sh.Cells(i, 18) = ComboBox8 Or ComboBox8 = "Tümü" Then
With ListBox1
.AddItem Format(sh.Cells(i, 2), "dd.mm.yyyy")
For j = 1 To 22
.List(ListBox1.ListCount - 1, j) = sh.Cells(i, j + 2)
Next j
' .List(ListBox1.ListCount - 1, 1) = sh.Cells(i, 1)
' .List(ListBox1.ListCount - 1, 2) = sh.Cells(i, 2)
' .List(ListBox1.ListCount - 1, 3) = sh.Cells(i, 3)
End With
End If
End If
End If
End If
End If
End If
End If
Next i
End If
x = 0
Next
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub CommandButton3_Click()
sirala
With Sheets("Rapor")
.Cells(2, 1) = "SORGU -> Tarih:" & ComboBox1 _
& ", Tarla Sahibi:" & ComboBox2 _
& ", Kime Gittiği:" & ComboBox3 _
& ", Plaka:" & ComboBox4 _
& ", Cinsi:" & ComboBox6 _
& ", Yükleme:" & ComboBox7 _
& ", İşcilik:" & ComboBox8
.Range("A5:AT10000").ClearContents
.Cells(4, 2).Resize(ListBox1.ListCount, 42) = ListBox1.List
For i = 4 To .Cells(65536, 2).End(xlUp).Row
Next i
End With
End Sub
Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim HaricSayfalar() As Variant
Dim sh As Object
Dim arrTarlaS() As Variant, arrKime() As Variant, arrPlaka() As Variant, arrCnisi() As Variant, arryükleme() As Variant, arrişcilik() As Variant
Dim arrVeri() As Variant
Dim colTarlaS As New Collection, colKime As New Collection, colPlaka As New Collection, colCinsi As New Collection, colyükleme As New Collection, colişcilik As New Collection
Dim Toplam As Long, y As Long
HaricSayfalar = Array("YAZDIR", "CARİ", "RAPOR", "LİSTE", "ŞABLON")
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then: Toplam = Toplam + (sh.Cells(65536, 2).End(xlUp).Row - 3)
x = 0
Next
ReDim arrTarlaS(Toplam)
ReDim arrKime(Toplam)
ReDim arrPlaka(Toplam)
ReDim arrCinsi(Toplam)
ReDim arryükleme(Toplam)
ReDim arrişcilik(Toplam)
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 5 To sh.Cells(65536, 2).End(xlUp).Row
arrTarlaS = sh.Cells(i, 3).Value
arrKime = sh.Cells(i, 4).Value
arrPlaka = sh.Cells(i, 5).Value
arrCinsi = sh.Cells(i, 9).Value
arryükleme = sh.Cells(i, 17).Value
arrişcilik = sh.Cells(i, 18).Value
y = y + 1
Next i
End If
x = 0
Next
On Error Resume Next
colTarlaS.Add "Tümü", "Tümü": colTarlaS.Add arrTarlaS(0), arrTarlaS(0)
colKime.Add "Tümü", "Tümü": colKime.Add arrKime(0), arrKime(0)
colPlaka.Add "Tümü", "Tümü": colPlaka.Add arrPlaka(0), arrPlaka(0)
colCinsi.Add "Tümü", "Tümü": colCinsi.Add arrCinsi(0), arrCinsi(0)
colyükleme.Add "Tümü", "Tümü": colyükleme.Add arryükleme(0), arryükleme(0)
colişcilik.Add "Tümü", "Tümü": colişcilik.Add arrişcilik(0), arrişcilik(0)
For i = 0 To UBound(arrTarlaS) - 1
For Each Eleman1 In colTarlaS
If Eleman1 = arrTarlaS(i) Then: x = x + 1
Next
If x = 0 Then colTarlaS.Add arrTarlaS(i), arrTarlaS(i)
x = 0
For Each Eleman2 In colKime
If Eleman2 = arrKime(i) Then: y = y + 1
Next
If y = 0 Then colKime.Add arrKime(i), arrKime(i)
y = 0
For Each Eleman3 In colPlaka
If Eleman3 = arrPlaka(i) Then: Z = Z + 1
Next
If Z = 0 Then colPlaka.Add arrPlaka(i), arrPlaka(i)
Z = 0
For Each Eleman4 In colCinsi
If Eleman4 = arrCinsi(i) Then: w = w + 1
Next
If w = 0 Then colCinsi.Add arrCinsi(i), arrCinsi(i)
w = 0
For Each Eleman5 In colyükleme
If Eleman5 = arryükleme(i) Then: c = c + 1
Next
If c = 0 Then colyükleme.Add arryükleme(i), arryükleme(i)
c = 0
For Each Eleman6 In colişcilik
If Eleman6 = arrişcilik(i) Then: g = g + 1
Next
If g = 0 Then colişcilik.Add arrişcilik(i), arrişcilik(i)
g = 0
Next
ComboBox1.AddItem "Tümü": ComboBox1.ListIndex = 0
For Each Eleman In colTarlaS: ComboBox2.AddItem Eleman: Next: ComboBox2.ListIndex = 0
For Each Eleman In colKime: ComboBox3.AddItem Eleman: Next: ComboBox3.ListIndex = 0
For Each Eleman In colPlaka: ComboBox4.AddItem Eleman: Next: ComboBox4.ListIndex = 0
For Each Eleman In colCinsi: ComboBox6.AddItem Eleman: Next: ComboBox6.ListIndex = 0
For Each Eleman In colyükleme: ComboBox7.AddItem Eleman: Next: ComboBox7.ListIndex = 0
For Each Eleman In colişcilik: ComboBox8.AddItem Eleman: Next: ComboBox8.ListIndex = 0
With ListBox1
.Clear
.ColumnCount = 4
.ColumnWidths = "100;135;112;100"
End With
ReDim arrVeri(1 To Toplam, 1 To 23)
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 4 To sh.Cells(65536, 2).End(xlUp).Row
a = a + 1
arrVeri(a, 1) = Format(sh.Cells(i, 2), "dd.mm.yyyy")
For j = 2 To 22
arrVeri(a, j) = sh.Cells(i, j + 1)
Next j
Next i
End If
x = 0
Next
DTPicker1.Value = Date
DTPicker2.Value = Date
ListBox1.List = arrVeri
CommandButton2.Cancel = True
ComboBox5.AddItem "Tümü"
ComboBox5.ListIndex = 0
ComboBox6.AddItem "Tümü"
ComboBox6.ListIndex = 0
ComboBox7.AddItem "Tümü"
ComboBox7.ListIndex = 0
ComboBox8.AddItem "Tümü"
ComboBox8.ListIndex = 0
End Sub
HATA KODU EKTE
Private Sub CommandButton1_Click() 'Sorgula
Dim HaricSayfalar() As Variant, son_tarih As Date
HaricSayfalar = Array("YAZDIR", "CARİ", "RAPOR", "LİSTE", "ŞABLON")
ListBox1.Clear
If IsDate(DTPicker1) = False And DTPicker1 <> "Tümü" Then
MsgBox "İlk Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If DTPicker1 <> "Tümü" Then Tarih = CDate(DTPicker1)
If IsDate(DTPicker2) = False And DTPicker2 <> "Tümü" Then
MsgBox "Son Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If DTPicker2 <> "Tümü" Then son_tarih = CDate(DTPicker2)
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 4 To sh.Cells(65536, 2).End(xlUp).Row
If DTPicker1.Value = "Tümü" Or DTPicker2.Value = "Tümü" Or sh.Cells(i, 2) >= Tarih _
And sh.Cells(i, 2) <= son_tarih Then
If sh.Cells(i, 3) = ComboBox2 Or ComboBox2 = "Tümü" Then
If sh.Cells(i, 4) = ComboBox3 Or ComboBox3 = "Tümü" Then
If sh.Cells(i, 5) = ComboBox4 Or ComboBox4 = "Tümü" Then
If sh.Cells(i, 9) = ComboBox6 Or ComboBox6 = "Tümü" Then
If sh.Cells(i, 17) = ComboBox7 Or ComboBox7 = "Tümü" Then
If sh.Cells(i, 18) = ComboBox8 Or ComboBox8 = "Tümü" Then
With ListBox1
.AddItem Format(sh.Cells(i, 2), "dd.mm.yyyy")
For j = 1 To 22
.List(ListBox1.ListCount - 1, j) = sh.Cells(i, j + 2)
Next j
' .List(ListBox1.ListCount - 1, 1) = sh.Cells(i, 1)
' .List(ListBox1.ListCount - 1, 2) = sh.Cells(i, 2)
' .List(ListBox1.ListCount - 1, 3) = sh.Cells(i, 3)
End With
End If
End If
End If
End If
End If
End If
End If
Next i
End If
x = 0
Next
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub CommandButton3_Click()
sirala
With Sheets("Rapor")
.Cells(2, 1) = "SORGU -> Tarih:" & ComboBox1 _
& ", Tarla Sahibi:" & ComboBox2 _
& ", Kime Gittiği:" & ComboBox3 _
& ", Plaka:" & ComboBox4 _
& ", Cinsi:" & ComboBox6 _
& ", Yükleme:" & ComboBox7 _
& ", İşcilik:" & ComboBox8
.Range("A5:AT10000").ClearContents
.Cells(4, 2).Resize(ListBox1.ListCount, 42) = ListBox1.List
For i = 4 To .Cells(65536, 2).End(xlUp).Row
Next i
End With
End Sub
Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim HaricSayfalar() As Variant
Dim sh As Object
Dim arrTarlaS() As Variant, arrKime() As Variant, arrPlaka() As Variant, arrCnisi() As Variant, arryükleme() As Variant, arrişcilik() As Variant
Dim arrVeri() As Variant
Dim colTarlaS As New Collection, colKime As New Collection, colPlaka As New Collection, colCinsi As New Collection, colyükleme As New Collection, colişcilik As New Collection
Dim Toplam As Long, y As Long
HaricSayfalar = Array("YAZDIR", "CARİ", "RAPOR", "LİSTE", "ŞABLON")
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then: Toplam = Toplam + (sh.Cells(65536, 2).End(xlUp).Row - 3)
x = 0
Next
ReDim arrTarlaS(Toplam)
ReDim arrKime(Toplam)
ReDim arrPlaka(Toplam)
ReDim arrCinsi(Toplam)
ReDim arryükleme(Toplam)
ReDim arrişcilik(Toplam)
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 5 To sh.Cells(65536, 2).End(xlUp).Row
arrTarlaS = sh.Cells(i, 3).Value
arrKime = sh.Cells(i, 4).Value
arrPlaka = sh.Cells(i, 5).Value
arrCinsi = sh.Cells(i, 9).Value
arryükleme = sh.Cells(i, 17).Value
arrişcilik = sh.Cells(i, 18).Value
y = y + 1
Next i
End If
x = 0
Next
On Error Resume Next
colTarlaS.Add "Tümü", "Tümü": colTarlaS.Add arrTarlaS(0), arrTarlaS(0)
colKime.Add "Tümü", "Tümü": colKime.Add arrKime(0), arrKime(0)
colPlaka.Add "Tümü", "Tümü": colPlaka.Add arrPlaka(0), arrPlaka(0)
colCinsi.Add "Tümü", "Tümü": colCinsi.Add arrCinsi(0), arrCinsi(0)
colyükleme.Add "Tümü", "Tümü": colyükleme.Add arryükleme(0), arryükleme(0)
colişcilik.Add "Tümü", "Tümü": colişcilik.Add arrişcilik(0), arrişcilik(0)
For i = 0 To UBound(arrTarlaS) - 1
For Each Eleman1 In colTarlaS
If Eleman1 = arrTarlaS(i) Then: x = x + 1
Next
If x = 0 Then colTarlaS.Add arrTarlaS(i), arrTarlaS(i)
x = 0
For Each Eleman2 In colKime
If Eleman2 = arrKime(i) Then: y = y + 1
Next
If y = 0 Then colKime.Add arrKime(i), arrKime(i)
y = 0
For Each Eleman3 In colPlaka
If Eleman3 = arrPlaka(i) Then: Z = Z + 1
Next
If Z = 0 Then colPlaka.Add arrPlaka(i), arrPlaka(i)
Z = 0
For Each Eleman4 In colCinsi
If Eleman4 = arrCinsi(i) Then: w = w + 1
Next
If w = 0 Then colCinsi.Add arrCinsi(i), arrCinsi(i)
w = 0
For Each Eleman5 In colyükleme
If Eleman5 = arryükleme(i) Then: c = c + 1
Next
If c = 0 Then colyükleme.Add arryükleme(i), arryükleme(i)
c = 0
For Each Eleman6 In colişcilik
If Eleman6 = arrişcilik(i) Then: g = g + 1
Next
If g = 0 Then colişcilik.Add arrişcilik(i), arrişcilik(i)
g = 0
Next
ComboBox1.AddItem "Tümü": ComboBox1.ListIndex = 0
For Each Eleman In colTarlaS: ComboBox2.AddItem Eleman: Next: ComboBox2.ListIndex = 0
For Each Eleman In colKime: ComboBox3.AddItem Eleman: Next: ComboBox3.ListIndex = 0
For Each Eleman In colPlaka: ComboBox4.AddItem Eleman: Next: ComboBox4.ListIndex = 0
For Each Eleman In colCinsi: ComboBox6.AddItem Eleman: Next: ComboBox6.ListIndex = 0
For Each Eleman In colyükleme: ComboBox7.AddItem Eleman: Next: ComboBox7.ListIndex = 0
For Each Eleman In colişcilik: ComboBox8.AddItem Eleman: Next: ComboBox8.ListIndex = 0
With ListBox1
.Clear
.ColumnCount = 4
.ColumnWidths = "100;135;112;100"
End With
ReDim arrVeri(1 To Toplam, 1 To 23)
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 4 To sh.Cells(65536, 2).End(xlUp).Row
a = a + 1
arrVeri(a, 1) = Format(sh.Cells(i, 2), "dd.mm.yyyy")
For j = 2 To 22
arrVeri(a, j) = sh.Cells(i, j + 1)
Next j
Next i
End If
x = 0
Next
DTPicker1.Value = Date
DTPicker2.Value = Date
ListBox1.List = arrVeri
CommandButton2.Cancel = True
ComboBox5.AddItem "Tümü"
ComboBox5.ListIndex = 0
ComboBox6.AddItem "Tümü"
ComboBox6.ListIndex = 0
ComboBox7.AddItem "Tümü"
ComboBox7.ListIndex = 0
ComboBox8.AddItem "Tümü"
ComboBox8.ListIndex = 0
End Sub
Ekli dosyalar
-
18 KB Görüntüleme: 8