kodları modüle taşıyarak for-next döngüsü kurmak

uzmanamele · 4 Aralık 2007

merhaba
ekte syn hsayar'ın yazmış olduğu kodlar çalışmasına rağmen düzenleme yapmak gerekiyor. arkadaşlarımız ilgilenir mi acaba?

1-) sayfanın kod bölümünden modüle taşınarak, sayfada ilgili alanda işlem yapıldığında devreye girmesi sağlanacak.
2-) veri girişleri belli sırada olmadığı durumda aktif hücredeki değerin değişmesine bağlı kalmayarak her defasında for-next döngüsü ile bütün veriler kontrol edilecek.
3-) tüm verileri kontrol ettiğinde hata mesajı verecek ama ilk hatalı verinin girildiği hücrede çakılı kalmayacak, tüm hatalı verileri silecek. (kopyala yapıştır ile veri girildiğinde birden fazla hatalı veri girilmiş olabilir)

hsayar · 4 Aralık 2007

hocam yarın bakmaya çalışrım yalnız sormak istediğim bir şey var

Tarihkontol Makrosu aktif sayfayımı tarayacak tüm kitabımı tarayacak
Tarihler G-H-I-J-L de kalacak hala değilmi?

uzmanamele · 4 Aralık 2007

merhaba
syn hsayar, mevcut sayfalarımda benzer şekilde çok sayıda hesap/işlem yapan makrolarım var. sayfanın kod bölümünde hepsini birleştirmek sorun oluyor. karmaşaya mahal vermemek için madüllerden çağırmak istiyorum.
tarih kontrol makrosu aktif sayfayı tarayacak.
imalat sayfasında G-H-I-J gerçekleşen sayfada sadece L sütununda çalışacak

not: takvim denetimini mevcut kodların dışında tutmakta fayda var. DatePicker takvimi kullanımına izin vermek doğru olur.

hsayar · 4 Aralık 2007

dosyayı ekledim açıklamaları yapacam

Kod:

Function ilkgün(tarih)
    ilkgün = Format(tarih - Day(tarih) + 1, "dd/mm/yyyy")
End Function
Function songün(tarih)
    songün = Format((DateSerial(Year(tarih), Month(tarih) + 1, 1)) - 1, "dd/mm/yyyy")
End Function

Kod:

Sub Tar_Kont()
Call Tar_Kont_1
Call Tar_Kont_2
Call Tar_Kont_3
Call Tar_Kont_3b
Call Tar_Kont_4
End Sub
[code]

Private Sub Tar_Kont_1()
Dim hucre As Range
For Each hucre In Range("g5:j20")
tarih = hucre.Value
'1 başlangıç ve bitiş tarihleri denetim tarihleri aralığında olmalıdır
If tarih <> "" Then
If hucre.Column = 7 Or hucre.Column = 8 Or _
hucre.Column = 9 Or hucre.Column = 10 Then
If tarih < Range("b3").Value Then
MsgBox hucre.Address & " Denetim Başlangıç tarihinden küçük tarih giremezsiniz"
hucre.Value = "": hucre.Interior.ColorIndex = 3
'GoTo 10
ElseIf tarih > Range("b4").Value Then
MsgBox hucre.Address & " Denetim Bitiş tarihinden büyük tarih giremezsiniz"
hucre.Value = "": hucre.Interior.ColorIndex = 3
'GoTo 10
End If
End If
End If
Next
End Sub
[/code]

Kod:

Private Sub Tar_Kont_2()
Dim hucre As Range
For Each hucre In Range("g5:j20")
    tarih = hucre.Value
'2 her aşamadaki bitiş tarihi başlangıç tarihinden en az 7 gün büyük olmalı
    If tarih <> "" Then
        If hucre.Column = 8 Or hucre.Column = 10 Then
        BsTr = hucre.Offset(0, -1).Value:             Fark = tarih - BsTr
            If Fark < 7 Then
                MsgBox hucre.Address & " Bitiş tarihi başlangıç tarihinden 7 gün fazla olmalıdır"
                hucre.Value = "": hucre.Interior.ColorIndex = 3
            End If
        End If
    End If
Next
End Sub

Kod:

Private Sub Tar_Kont_3()
Dim hucre As Range
For Each hucre In Range("j5:j20")
    tarih = hucre.Value
'3 2. aşama başlangıç tarihi 1. aşama bitiş tarihinden en az 7 gün büyük olmalı
    If tarih <> "" Then
        If hucre.Column = 9 Then
        BsTr = hucre.Offset(0, -1).Value:             Fark = tarih - BsTr
            If Fark < 7 Then
                MsgBox hucre.Address & " 2. Aşama Başlangıç tarihi, 1. aşama bitiş tarihinden 7 gün fazla olmalıdır"
                hucre.Value = "": hucre.Interior.ColorIndex = 3
            End If
        End If
    End If
Next
End Sub

Kod:

Private Sub Tar_Kont_3b()
Dim hucre As Range
For Each hucre In Range("I5:j20")
    tarih = hucre.Value
'''''1. aşama için başlangıç bitiş tarihi girilmemişse 2. aşama için giriş yapamazsınız
    If tarih <> "" Then
        If hucre.Column = 9 Or hucre.Column = 10 Then
            BStr1 = hucre.Offset(0, -2).Value '5 sütun önce
            Bttr1 = hucre.Offset(0, -1).Value '4 sütun önce
            If BStr1 = "" Or Bttr1 = "" Then
                'If tarih < BStr1 Or tarih > Bttr1 Then
                 MsgBox hucre.Address & "  1. Aşama için başlangıç ve bitiş tarihleri girilmemiş!"
                    'hucre.Value = ""
                    hucre.Interior.ColorIndex = 3
            End If
        End If
   End If
Next
End Sub

Kod:

Private Sub Tar_Kont_4()
Dim hucre As Range
For Each hucre In Range("L5:L20")
    tarih = hucre.Value
'''''4 kontrol tarihi, denetim tarihleri aralığında olmalıdır
    If tarih <> "" Then
        If hucre.Column = 12 Then
            BStr1 = hucre.Offset(0, -5).Value '5 sütun önce
            Bttr1 = hucre.Offset(0, -4).Value '4 sütun önce
            BStr2 = hucre.Offset(0, -3).Value '3 sütun önce
            Bttr2 = hucre.Offset(0, -2).Value '2 sütun önce
                If BStr1 <> "" Or Bttr1 <> "" Or BStr2 = "" Or Bttr2 = "" Then
                    If tarih < BStr1 Or tarih > Bttr1 Then
                        MsgBox hucre.Address & "  1. Aşama için yanlış aralıkta kontrol tarihi girdiniz"
                        'hucre.Value = ""
                        hucre.Interior.ColorIndex = 3
                    End If
                End If
                
                If BStr2 <> "" Or Bttr2 <> "" Then
                    If tarih < BStr2 Or tarih > Bttr2 Then
                        MsgBox hucre.Address & "  2. Aşama için yanlış aralıkta kontrol tarihi girdiniz"
                        'hucre.Value = ""
                        hucre.Interior.ColorIndex = 3
                    End If
                End If
        End If
   End If
Next
End Sub

Kodları inceleyiniz;
hucre.Value = "": hucre.Interior.ColorIndex = 3

satırlarında hucre value = "" stırlarını kapatıp interior kullanabilirsiniz aksi takdirde formulüde silecektir... ben onu unuttum bir inceleyin
Tarih kontol butonunu istediğiniz sayfaya kopyalayarak kullabilirisiniz....

başka bir sorun çıkarsa bakarız

uzmanamele · 4 Aralık 2007

merhaba
syn hsayar, kodları kendi çalışmama adapte ettim, elinize sağlık.
Private Sub Tar_Kont_4() yordamına ilkgün fonksiyonunu ilave edebilir misiniz?

uzmanamele · 4 Aralık 2007

merhaba
1-) Private Sub Tar_Kont_4() yordamında; 2. aşama için tarih kontrolü yaparken 1. aşamayla ilgili tarih girildiğinde hata veriyor. kıyaslamayı düzeltmek lazım.
If BStr2 <> "" Or Bttr2 <> "" Then
If tarih < BStr2 Or tarih > Bttr2 Then
MsgBox hucre.Address & " 2. Aşama için yanlış aralıkta kontrol tarihi girdiniz"
'hucre.Value = ""
hucre.Interior.ColorIndex = 3
End If
2-) doğru tarih girildiğinde, girilen ayın ilk gününü aynı hücreye yazmak gerekiyor (15.05.08 için 01.05.08 gibi)

uzmanamele · 4 Aralık 2007

merhaba
Private Sub Tar_Kont_4() için kodların çalışma şekli biraz karışık, kısaca anlatmaya çalışayım:
burada kontrol tarihi girişi opsiyonel, eğer girilecekse ilgili aralıkta kalması lazım.
a-) tarih girişi, işin başlangıç ve bitiş tarihi aralığında olmalı
b-) 1. aşama ile ilgili tarih girilmek istendiğinde 2. aşama tarihlerini dikkate alma
c-) 2. aşama ile ilgili tarih girilmek istendiğinde 1. aşama tarihlerini dikkate alma
d-) doğru tarih girildiğinde, girilen ayın ilk gününü aynı hücreye yazmak gerekiyor (15.05.08 için 01.05.08 gibi)
bu denetimi yapabilmek için, bir şart sağlanmışsa 2. şartı kontrol etmek üzere if-end if kıyaslamasının arasından 2. denetimi yaptırmak lazım.
If BStr1 <> "" Or Bttr1 <> "" Or BStr2 = "" Or Bttr2 = "" Then
If tarih < BStr1 Or tarih > Bttr1 Then
MsgBox hucre.Address & " Hücresinde; 1. Aşama İçin Yanlış Aralıkta Kontrol Tarihi Girdiniz!", vbCritical, "UYARI"
hucre.Value = ""
'hucre.Interior.ColorIndex = 3 (gerekirse hücre renklendir)
End If
End If

If BStr2 <> "" Or Bttr2 <> "" Then
If tarih < BStr2 Or tarih > Bttr2 Then
MsgBox hucre.Address & " Hücresinde; 2. Aşama İçin Yanlış Aralıkta Kontrol Tarihi Girdiniz!", vbCritical, "UYARI"
hucre.Value = ""
'hucre.Interior.ColorIndex = 3 (gerekirse hücre renklendir)
End If
End If

hsayar · 4 Aralık 2007

hatalı kodlar doğrusu bir alttadır.

hsayar · 4 Aralık 2007

Kod:

Private Sub Tar_Kont_4()
Dim hucre As Range
For Each hucre In Range("L5:L20")
    tarih = hucre.Value
'''''4 kontrol tarihi, denetim tarihleri aral&#305;&#287;&#305;nda olmal&#305;d&#305;r
    If tarih <> "" Then
        If hucre.Column = 12 Then
            BStr1 = hucre.Offset(0, -5).Value '5 s&#252;tun &#246;nce
            Bttr1 = hucre.Offset(0, -4).Value '4 s&#252;tun &#246;nce
            BStr2 = hucre.Offset(0, -3).Value '3 s&#252;tun &#246;nce
            Bttr2 = hucre.Offset(0, -2).Value '2 s&#252;tun &#246;nce
                If (BStr1 <> "" Or Bttr1 <> "") And (BStr2 = "" Or Bttr2 = "") Then
                'If BStr1 <> "" And Bttr1 <> "" Then
                    If tarih < BStr1 Or tarih > Bttr1 Then
                        MsgBox hucre.Address & "  1. A&#351;ama i&#231;in yanl&#305;&#351; aral&#305;kta kontrol tarihi girdiniz"
                        'hucre.Value = ""
                        hucre.Interior.ColorIndex = 3
                    Else
                        hucre.Value = CDate(ilkg&#252;n(hucre.Value))
                    End If
                End If
                
                 If (BStr1 <> "" Or Bttr1 <> "") And (BStr2 <> "" And Bttr2 <> "") Then
                    If tarih < BStr2 Or tarih > Bttr2 Then
                        MsgBox hucre.Address & "  2. A&#351;ama i&#231;in yanl&#305;&#351; aral&#305;kta kontrol tarihi girdiniz"
                        'hucre.Value = ""
                        hucre.Interior.ColorIndex = 3
                    Else
                        hucre.Value = CDate(ilkg&#252;n(hucre.Value))
                        
                    End If
                End If
        End If
   End If
Next
End Sub

bunları deneyin formatı tarih olarak görmediği için hata veriyormuş.....

uzmanamele · 4 Aralık 2007

merhaba
düzeltmeye çalıştım ama beyin durdu.
a-) If Başla_1 <> "" And Başla_2 = "" Then
If tarih < Başla_1 Or tarih > Bitir_1 Then
MsgBox hucre.Address & " 1. Aşama için yanlış aralıkta kontrol tarihi girdiniz", vbCritical, "UYARI"
hucre.Value = ""
Else
hucre.Value = CDate(ilkgün(hucre.Value))
End If

b-) If Başla_2 <> "" Then
If tarih < Başla_1 Or tarih > Bitir_2 Then
MsgBox hucre.Address & " 2. Aşama için yanlış aralıkta kontrol tarihi girdiniz", vbCritical, "UYARI"
hucre.Value = ""
End If

c-) If tarih > Bitir_1 And tarih < Başla_2 Then
MsgBox hucre.Address & " bu tarihte imalat yok!", vbCritical, "UYARI"
hucre.Value = ""
Else
hucre.Value = CDate(ilkgün(hucre.Value))
End If

bu şekilde olmalı, ama nasıl?

hsayar · 4 Aralık 2007

hocam siz türkçesini yazın vba ya çeviren bir çıkar ben anlamadım
[code ] [/code ] içinde yazarsanız daha iyi olur

9. mesajdaki kodları denediniz mi?

kodları modüle taşıyarak for-next döngüsü kurmak

uzmanamele

Uzman

hsayar

uzmanamele

Uzman

hsayar

uzmanamele

Uzman

uzmanamele

Uzman

uzmanamele

Uzman

hsayar

hsayar

uzmanamele

Uzman

hsayar