• DİKKAT

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

Açık olan hesapların toplam adeti ve tutarını makro ile bulmak istiyorum.

  • 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.
Ekteki belgede frmRAPOR isimli form üzerinde bulunan;
label69 için: Onay Defteri 2011 sayfasında tenkis edilerek karara bağlanmamış kaç adet m.19 olduğunu,
label77 için ise: Tenkis edilerek kapatılmamış m.19 ların toplam tutarını verecek koda ihtiyacım var.
Yardımcı olacak arkadaşlara teşekkür ederim.
 

Ekli dosyalar

İyi geceler arkadaşlar.
Ekteki belgede frmRAPOR isimli form üzerinde bulunan;
label69 için: Onay Defteri 2011 sayfasında tenkis edilerek karara bağlanmamış kaç adet m.19 olduğunu,
label77 için ise: Tenkis edilerek kapatılmamış m.19 ların toplam tutarını verecek koda ihtiyacım var.

'frmRAPOR Initialize' altına aşağıdaki kırmızı bölümleri değiştirin/ekleyin.

Kod:
 Private Sub UserForm_Initialize()
[COLOR="Red"]Dim Bul As Range, Sayfa As String, a, b, c, d As Variant[/COLOR]
Sayfa = Left(Sheets("Sabit").Range("F1"), 4)

Dim hWnd As Long
'............
'.......
'...............
'...............
Label56.Caption = Sheets(Sayfa & "_BÜTÇESİ").Range("e9").Value
Label56 = FormatCurrency(Label56.Caption, 2)
[COLOR="Red"]Me.Controls("Label85").Caption = 0
Me.Controls("Label57").Caption = 0
For a = 61 To 68
c = 0
d = 0
For b = 2 To Sheets("Onay Defteri " & Sayfa).Cells(65000, 5).End(xlUp).Row
If Cells(b, 5) = Me.Controls("Label" & a).Caption Then
If Cells(b, 8) = "" Then
c = c + 1
Me.Controls("Label85").Caption = Me.Controls("Label85").Caption + 1
d = d + Cells(b, 7)
End If
End If
Me.Controls("Label" & a + 8).Caption = c
Me.Controls("Label" & a + 16).Caption = Format(d, "#,##0.00 TL")
Next
Me.Controls("Label57").Caption = Me.Controls("Label57").Caption + d
Next
Me.Controls("Label57").Caption = Format(Me.Controls("Label57").Caption, "#,##0.00 TL")[/COLOR]
End Sub

Bu arada:
"frmONAY" KOD sayfasında "Sub grup" altında bulunan "List Index" den seçilenlerde "sabit" sayfasına göre alınmayanlar bulunuyor, örneğin:
"sabit" sayfası 23. satır (740-08 Yiyecek Grubu, ComboBox1.ListIndex e göre;21. sıra) bilinçli değilse; bunları düzeltin.
 
'frmRAPOR Initialize' altına aşağıdaki kırmızı bölümleri değiştirin/ekleyin.

Kod:
 Private Sub UserForm_Initialize()
[COLOR="Red"]Dim Bul As Range, Sayfa As String, a, b, c, d As Variant[/COLOR]
Sayfa = Left(Sheets("Sabit").Range("F1"), 4)

Dim hWnd As Long
'............
'.......
'...............
'...............
Label56.Caption = Sheets(Sayfa & "_BÜTÇESİ").Range("e9").Value
Label56 = FormatCurrency(Label56.Caption, 2)
[COLOR="Red"]Me.Controls("Label85").Caption = 0
Me.Controls("Label57").Caption = 0
For a = 61 To 68
c = 0
d = 0
For b = 2 To Sheets("Onay Defteri " & Sayfa).Cells(65000, 5).End(xlUp).Row
If Cells(b, 5) = Me.Controls("Label" & a).Caption Then
If Cells(b, 8) = "" Then
c = c + 1
Me.Controls("Label85").Caption = Me.Controls("Label85").Caption + 1
d = d + Cells(b, 7)
End If
End If
Me.Controls("Label" & a + 8).Caption = c
Me.Controls("Label" & a + 16).Caption = Format(d, "#,##0.00 TL")
Next
Me.Controls("Label57").Caption = Me.Controls("Label57").Caption + d
Next
Me.Controls("Label57").Caption = Format(Me.Controls("Label57").Caption, "#,##0.00 TL")[/COLOR]
End Sub

Bu arada:
"frmONAY" KOD sayfasında "Sub grup" altında bulunan "List Index" den seçilenlerde "sabit" sayfasına göre alınmayanlar bulunuyor, örneğin:
"sabit" sayfası 23. satır (740-08 Yiyecek Grubu, ComboBox1.ListIndex e göre;21. sıra) bilinçli değilse; bunları düzeltin.

İlgine teşekkür ederim arkadaşım.
Bu arada:
"frmONAY" KOD sayfasında "Sub grup" altında bulunan "List Index" den seçilenlerde "sabit" sayfasına göre alınmayanlar bulunuyor, örneğin:
"sabit" sayfası 23. satır (740-08 Yiyecek Grubu, ComboBox1.ListIndex e göre;21. sıra) bilinçli değilse; bunları düzeltin.
Haklısınız 740.08, 740.104, 740.112, 740.12, 740.17 ve 740.99 bütçe kodlarının M sütunundan istenen veriyi verdiğini, ancak grup dan alması gereken veriyi almadığını tespit ettim ve aşağıdaki şekilde düzelttim.

Kod:
Sub grup()
Sayfa = Left(Sheets("Sabit").Range("F1"), 4)
Select Case ComboBox1.ListIndex
Case 1 To 21, 34, 37 To 42
TextBox5.Value = FormatCurrency(Sheets(Sayfa & "_BÜTÇESİ").Range("l7").Value, 2)

Case 22 To 30, 33, 35, 36
TextBox5.Value = FormatCurrency(Sheets(Sayfa & "_BÜTÇESİ").Range("l8").Value, 2)

Case 0, 31, 32
TextBox5.Value = FormatCurrency(Sheets(Sayfa & "_BÜTÇESİ").Range("l9").Value, 2)

End Select
End Sub

Son yazdığınız kodlarda ise sanırım bir sıkıntı var, kapatılmamış alımlar olmasına rağmen boş gösteriyor.
 

Ekli dosyalar

Son yazdığınız kodlarda ise sanırım bir sıkıntı var, kapatılmamış alımlar olmasına rağmen boş gösteriyor.

İlk gönderdiğiniz dosyada "propertis" ten örneğin "Label61" "caption" 'a "m.19" 'u boşluk bırakmadan yazmışsınız,
son dosyanızda "Label61" "caption" da " m.19" şeklinde boşluk var. Bu şekilde kullanacaksanız; aşağıdaki kırmızı bölümü ekleyin.

Kod:
For b = 2 To Sheets("Onay Defteri " & Sayfa).Cells(65000, 5).End(xlUp).Row
If [COLOR="Red"]" " & [/COLOR]Cells(b, 5) = Me.Controls("Label" & a).Caption Then
 
İlk gönderdiğiniz dosyada "propertis" ten örneğin "Label61" "caption" 'a "m.19" 'u boşluk bırakmadan yazmışsınız,
son dosyanızda "Label61" "caption" da " m.19" şeklinde boşluk var. Bu şekilde kullanacaksanız; aşağıdaki kırmızı bölümü ekleyin.

Kod:
For b = 2 To Sheets("Onay Defteri " & Sayfa).Cells(65000, 5).End(xlUp).Row
If [COLOR="Red"]" " & [/COLOR]Cells(b, 5) = Me.Controls("Label" & a).Caption Then

Teşekkür ederim üstat, eline sağlık.
 
Geri
Üst