Makroya ilave kod ekleme

[yildirimm]

merhaba arkadaşlar aşağıda yaptıgım programlamla ilgili kodlar mevcuttur kısaca anasayfada bilgicek butonu var ve g 29 ile h29 hücresine tarih yazilior g28 hücresinede bilgisi istenen malzeme yazilior ve bilgi cek butonuna bastimi o malzemeye ait bilgiyi verior benim istediğim g28 hücresine yazı yazmadanda bütün malzemelere ait haftalık bilgileri görebilmek icin g28 g29 hücresine tarih aralıgını yazacam yani malzemeyi girmedende bütün bilgiler gelecek asagidaki kodlarda malzemeyi yazınca bilgiler sorunsuz geliıo benim istedigim g28 hücresine malzeme yazmadanda bilgilerin tarihleri yazdim mi gelmesi tşkler


Sub bilgicek()
Dim sütün
On Error Resume Next
Set s1 = Sheets("Anasayfa")
s1.Range("C23:I25") = 0
gun1 = CLng(CDate(s1.Range("g29").Value))
gun2 = CLng(CDate(s1.Range("h29").Value))
no1 = s1.Range("G28").Value
sütün = 1
For a = 1 To Sheets.Count
If Sheets(a).Name = "Anasayfa" Then GoTo 10
For b = 5 To Sheets(a).[a65536].End(3).Row
If CLng(CDate(Sheets(a).Cells(b, "a"))) >= gun1 And CLng(CDate(Sheets(a).Cells(b, "a"))) <= gun2 Then
If Sheets(a).Cells(b, "b") <> no1 Then GoTo 20
deg1 = Sheets(a).Cells(b, "&#305;") + deg1
deg2 = Sheets(a).Cells(b, "k") + deg2
deg3 = Sheets(a).Cells(b, "l") + deg3
End If
20 Next
Cells(22, 2 + s&#252;t&#252;n) = Sheets(a).Name
Cells(23, 2 + s&#252;t&#252;n) = deg3
Cells(24, 2 + s&#252;t&#252;n) = deg2
Cells(25, 2 + s&#252;t&#252;n) = deg1
s&#252;t&#252;n = s&#252;t&#252;n + 1
If s&#252;t&#252;n = 4 Then s&#252;t&#252;n = 5
deg1 = Empty
deg2 = Empty
deg3 = Empty
10 Next
End Sub

 

[yildirimm]

sanırım konu anlasilmadi onun icin örnek bir dosya ekliyorum ve benim yaptigim olay şu anasayfada taş nosu yazip sonra gerekli hücrelere tarihleri giriorum ve cilgi cek diyince bana bu değerleri st1 st2 gösteriyor örnek dosyada mevcut benim istediğim tam olarak taş nosu yazilmadan sadece tarih yazılacak ve o sayfalardaki değerler yine gelecek ama bu el toplam olarak toplayacak yani örnek dosya ektedir ve ekte açıklama mevcuttur

Kul adi: AYKUT şifre: 123456A

 

[xxcell]

Sn. Y&#305;ld&#305;r&#305;m,
Sabah &#231;ok yo&#287;un oldu&#287;um i&#231;in ilgilenemedim,
Kodunu a&#351;a&#287;&#305;daki &#351;ekilde de&#287;i&#351;tirirsen, istedi&#287;in oluyor.
Yo&#287;un oldu&#287;um i&#231;in ufak ayr&#305;nt&#305;lar&#305; sana b&#305;rakt&#305;m.
Bi&#231;imlemeler felan gerekirse yapars&#305;n.

bide ufak bir not, TAR&#304;H ARALI&#286;INI M29 : N29 'a kayd&#305;rmam gerekti. Kodu &#231;al&#305;&#351;t&#305;rmadan &#246;nce tarihi oraya kayd&#305;r.

Sub bilgicek()
Dim sütün
On Error Resume Next
Set S1 = Sheets("Anasayfa")
S1.Range("a22:K" & S1.[A65536].End(xlUp).Row) = ""
gun1 = CLng(CDate(S1.Range("m29").Value))
gun2 = CLng(CDate(S1.Range("n29").Value))

'

'taş no'ları belirle

Dim taslar(100) As String
tasno = 1

For a = 1 To Sheets.Count
If Not Sheets(a).Name = "Anasayfa" Then
satir = 5
Do While satir <= Sheets(a).[b65536].End(3).Row

n = 1
eslesme = 0

Do While Len(taslar(n)) > 0
If Sheets(a).Cells(satir, 2) = taslar(n) Then
eslesme = 1
Exit Do
Else
n = n + 1
End If
Loop

If eslesme = 0 Then
taslar(tasno) = Sheets(a).Cells(satir, 2)

tasno = tasno + 1
If tasno = 101 Then tasno = 1
End If

satir = satir + 1
Loop
End If
Next


satir = 23

For n = 1 To tasno - 1


no1 = taslar(n)


s&#252;t&#252;n = 1
For a = 1 To Sheets.Count
    If Sheets(a).Name = "Anasayfa" Then GoTo 10
    For b = 5 To Sheets(a).[A65536].End(3).Row
         If CLng(CDate(Sheets(a).Cells(b, "a"))) >= gun1 And CLng(CDate(Sheets(a).Cells(b, "a"))) <= gun2 Then
         If Sheets(a).Cells(b, "b") <> no1 Then GoTo 20
            deg1 = Sheets(a).Cells(b, "&#305;") + deg1
            deg2 = Sheets(a).Cells(b, "k") + deg2
            deg3 = Sheets(a).Cells(b, "l") + deg3
           
    
         End If
20 Next
    
    S1.Cells(22, 2 + s&#252;t&#252;n) = Sheets(a).Name

    S1.Cells(satir, 2 + s&#252;t&#252;n) = deg3
    S1.Cells(satir + 1, 2 + s&#252;t&#252;n) = deg2
    S1.Cells(satir + 2, 2 + s&#252;t&#252;n) = deg1
    
    s&#252;t&#252;n = s&#252;t&#252;n + 1
    
    
    If s&#252;t&#252;n = 4 Then s&#252;t&#252;n = 5
    deg1 = Empty
    deg2 = Empty
    deg3 = Empty
   
10 Next
S1.Cells(satir, 1) = "verim"
S1.Cells(satir + 1, 1) = "fire"
S1.Cells(satir + 2, 1) = "m3"
S1.Cells(satir, 2) = taslar(n)
satir = satir + 3
Next


End Sub