• DİKKAT

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

Listwiev'da koşullu süzme?

  • Konbuyu başlatan Konbuyu başlatan s.savas
  • Başlangıç tarihi Başlangıç tarihi
Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
İyi geceler arkadaşlar.
Aşağıdaki kod ile Listwiev1'de gösterilen verilerden
Kod:
l.SubItems(8) = FormatCurrency(sh.Cells(i, 8))
satırında değeri sıfır (0) olan verileri TextBox, ComboBox veya OptionButton yardımı ile süzecek bir makro tanımlanabilirmi.

Yardımcı olacak arkadaşlara teşekkür ederim.

Kod:
Private Sub UserForm_Initialize()
Dim hWnd As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000

Application.Visible = False
Sheets("Onay Defteri " & Left(Sheets("BÜTÇE_KODU").Range("D1"), 4)).Select

On Error Resume Next
Set s1 = Sheets("Onay Defteri " & Left(Sheets("BÜTÇE_KODU").Range("D1"), 4))
ListView1.View = lvwReport
With Me.ListView1
  .Gridlines = True
  .FullRowSelect = True
  .View = lvwReport
  .ListItems.Clear
  .ColumnHeaders.Clear
End With
With ListView1
.View = lvwReport
.ColumnHeaders.Add , , "no ", 0
.ColumnHeaders.Add , , "Onay No ", 45, lvwColumnCenter
.ColumnHeaders.Add , , "Onay Tarihi", 60, lvwColumnLeft
.ColumnHeaders.Add , , "Mal veya Hizmetin Adı", 130, lvwColumnLeft
.ColumnHeaders.Add , , "Bütçe Kodu / Hesap Adı", 130, lvwColumnLeft
.ColumnHeaders.Add , , "Alım Yöntemi", 70, lvwColumnLeft
.ColumnHeaders.Add , , "Kullanılabilir Bütçe", 80, lvwColumnRight
.ColumnHeaders.Add , , "Tenkis Edilen", 80, lvwColumnRight
.ColumnHeaders.Add , , "Gerçekleşen", 80, lvwColumnRight
.ColumnHeaders.Add , , "Tarihi", 70, lvwColumnCenter
.ColumnHeaders.Add , , "Açıklama", 70, lvwColumnLeft
.ColumnHeaders.Add , , "Onayı Alan", 70, lvwColumnLeft
'.ColumnHeaders.Add , , "Alım Türü", 70, lvwColumnLeft
'.ColumnHeaders.Add , , "Harcama Grubu", 70, lvwColumnLeft

.FullRowSelect = True
.Gridlines = True
End With

Set sh = Sheets("Onay Defteri " & Left(Sheets("BÜTÇE_KODU").Range("D1"), 4))
son = sh.Cells(65536, 1).End(xlUp).Row

For i = 2 To son
If sh.Cells(i, 2) <> "" Then
Set l = ListView1.ListItems.Add

l.Text = i
l.SubItems(1) = sh.Cells(i, 1) 'Onay No
l.SubItems(2) = FormatDateTime(sh.Cells(i, 2), vbGeneralDate) 'Onay Tarihi
l.SubItems(3) = sh.Cells(i, 3) 'Malzemenin / Hizmetin Adı
l.SubItems(4) = sh.Cells(i, 4) 'BÜTÇE_KODU
l.SubItems(5) = sh.Cells(i, 5) 'Alım Yöntemi
l.SubItems(6) = FormatCurrency(sh.Cells(i, 6)) 'Kalan Ödenek
l.SubItems(7) = FormatCurrency(sh.Cells(i, 7)) 'Yaklaşık Maliyet
l.SubItems(8) = FormatCurrency(sh.Cells(i, 8)) 'Karara Bağlanan
l.SubItems(9) = sh.Cells(i, 10) 'Gerçekleşme Tarihi
l.SubItems(10) = sh.Cells(i, 11) 'Açıklama
l.SubItems(11) = sh.Cells(i, 12) 'Kullanıcı
'l.SubItems(12) = sh.Cells(i, 15) 'Alım Türü
'l.SubItems(13) = sh.Cells(i, 16) 'Harcama Grubu

Call süz
End If
Next i

ListView1.FullRowSelect = True
ListView1.Gridlines = True

For i = 1 To ListView1.ListItems.Count
If ListView1.ListItems(i).SubItems(8) = "0" Or ListView1.ListItems(i).SubItems(8) = "" Then
For a = 1 To ListView1.ColumnHeaders.Count
    ListView1.ListItems(i).ListSubItems(a).ForeColor = vbBlue
    ListView1.ListItems(i).ListSubItems(a).Bold = True
Next a
End If
Next i



ComboBox1.RowSource = "BÜTÇE_KODU!B2:B" & Sheets("BÜTÇE_KODU").Range("B65536").End(3).Row
ComboBox2.RowSource = "ALIM_YÖNTEMİ!B2:B" & Sheets("ALIM_YÖNTEMİ").Range("B65536").End(3).Row
ComboBox3.Value = Sheets("KULLANICI").Range("IV65536")
ComboBox4.RowSource = "BÜTÇE_KODU!B2:B" & Sheets("BÜTÇE_KODU").Range("B65536").End(3).Row
ComboBox5.RowSource = "ALIM_YÖNTEMİ!B2:B" & Sheets("ALIM_YÖNTEMİ").Range("B65536").End(3).Row
ComboBox6.RowSource = "KULLANICI!B2:B" & Sheets("KULLANICI").Range("B65536").End(3).Row

ComboBox7.AddItem "Mal Alımı"
ComboBox7.AddItem "Hizmet Alımı"
ComboBox7.AddItem "Yapım İşi"

ComboBox8.AddItem "%10'a Tabii Olan"
ComboBox8.AddItem "%10'a Tabii Olmayan"

TextBox1.Text = Date
TextBox12.Enabled = False
CommandButton9.Visible = False
CheckBox1.Value = True
CheckBox1.Enabled = False

Dim son1 As Integer
son1 = Cells(65536, "a").End(xlUp).Row
TextBox4.Value = son1

End Sub
 
Geri
Üst