• DİKKAT

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

Private Sub ve Sub Kod Hatası

Katılım
15 Ocak 2013
Mesajlar
116
Excel Vers. ve Dili
2010 Turkce
Arkadaşlar ekteki dosya da programı çalıştırdığımda hata almaktayım.

Konu ile ilgili destek verebilecek arkadaş var mı?

Excell içinde tablo kullanırsam hata alıyorum fakat tablo kullanmazsam hata almadan sistem çalışıyor. bir türlü tespit edemedim hatanın kaynağını. Yardımlarınızı bekliyorum.
 

Ekli dosyalar

Merhaba, UserForm3'teki CommandButton1_Click olayındaki ilk iki döngüyü 4'ten başlatarak dener misiniz? 3. satırda başlıklar yer alıyor, başlıklar hata vermesine sebep oluyor olabilir.
 
Kod:
Private Sub CommandButton1_Click()

Dim z
For z = 4 To Cells(Rows.Count, "C").End(3).Row '4. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
Cells(z, "D").Value = Format(Cells(z, "C").Value + 3, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
Next
For z = 4 To Cells(Rows.Count, "C").End(3).Row '4. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
Cells(z, "G").Value = Format(Cells(z, "C").Value + 11, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
Next

Dim i, mydate, DUN
mydate = CDate(FormatDateTime(Now, vbShortDate))
DUN = CDate(FormatDateTime((Now - TimeSerial(24, 0, 0)), vbShortDate)) ' bu günden bir gün oncesinin tarihini buluyor dün
    For i = 4 To Cells(Rows.Count, "D").End(3).Row '4. satırdan itibaren dolu satır sayısınca döngü yapıyor
        'MsgBox CDate(FormatDateTime(Cells(i, "C").Value, vbShortDate))

        If Cells(i, "F").Value = "" Then
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = mydate Or CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = DUN Then
        Cells(i, "E").Value = "Zaman Doldu!"
            Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
       .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535 'seçili hücre rengini sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) > mydate Then
                Cells(i, "E").Value = "Zamanı devam etmekte!"
        Range("A" & i & ":AQ" & i).Select
                With Selection.Interior
         .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0 ' seçili hücre rengini turuncu yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
      .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        Cells(i, "E").Value = "Zamanı Geçti"
        Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10498160 ' seçili hücreyi mor yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
      End With
    Selection.Font.Bold = True
                 End If
               End If
            End If
Next

Dim n
For n = 4 To Cells(Rows.Count, "E").End(3).Row ' 4. satırdan itibaren  "D" hücresi için dolu satır sayısınca döngü yapıyor
If Cells(n, "F") = "ok" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "boş" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "vazgeç" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "aktiflendi" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "süresinde iptal" Then Cells(n, "E").Value = ""
Next

Dim a
Sheets("STS").Columns(132).ClearContents
Sheets("STS").Columns(136).ClearContents
For a = 1 To [E1048576].End(xlUp).Row
If Cells(i, "F").Value = "" Then
If Cells(a, 5) = "Zaman Doldu!" Then
[eb1048576].End(xlUp).Offset(1, 0) = Cells(a, 1)
[ef1048576].End(xlUp).Offset(1, 0) = Cells(a, 2)
Range(Cells(a, 1), Cells(a, 43)).Select
                With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535   ' seçilen hücreyi sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
End If
End If
Next a
If [EB2] <> "" Then
If [EF2] <> "" Then
MsgBox "Zaman Doldu", vbInformation, "STS DESTEK"
UserForm1.Show
End If
End If

Sheets("STS").Columns(133).ClearContents
Sheets("STS").Columns(137).ClearContents
For v = 1 To [F1048576].End(xlUp).Row
If Cells(v, 6) = "vazgeç" Then
[ec1048576].End(xlUp).Offset(1, 0) = Cells(v, 1)
[eg1048576].End(xlUp).Offset(1, 0) = Cells(v, 2)
Range(Cells(v, 1), Cells(v, 43)).Interior.Color = 15773696
     With Range(Cells(v, 1), Cells(v, 43)).Font
        .Color = -16711681
        .TintAndShade = 0
    End With
End If

Next v
If [EC2] <> "" Then
If [EG2] <> "" Then
MsgBox "Vazgeçildi.", vbInformation, "STS DESTEK"
UserForm2.Show
End If
End If

Sheets("STS").Columns(134).ClearContents
Sheets("STS").Columns(139).ClearContents
For q = 1 To [F1048576].End(xlUp).Row
If Cells(q, 6) = "ok" Then
[ed1048576].End(xlUp).Offset(1, 0) = Cells(q, 1)
[ei1048576].End(xlUp).Offset(1, 0) = Cells(q, 2)
Range(Cells(q, 1), Cells(q, 43)).Interior.Color = 8641970
     With Range(Cells(q, 1), Cells(q, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With
End If

Next q
If [ED2] <> "" Then
If [EI2] <> "" Then
MsgBox "Sistem ok.", vbInformation, "STS DESTEK"
UserForm4.Show
End If
End If

For y = 1 To [F1048576].End(xlUp).Row
If Cells(y, 6) = "boş" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [F1048576].End(xlUp).Row
If Cells(y, 6) = "ok" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 8641970
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With

End If
Next
For y = 1 To [F1048576].End(xlUp).Row
If Cells(y, 6) = "aktiflendi" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 4362752
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [F1048576].End(xlUp).Row
If Cells(y, 6) = "süresinde iptal" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
End Sub


Merhaba, UserForm3'teki CommandButton1_Click olayındaki ilk iki döngüyü 4'ten başlatarak dener misiniz? 3. satırda başlıklar yer alıyor, başlıklar hata vermesine sebep oluyor olabilir.


yukardaki gibi kodları düzenledim fakat dolu satır boyunca işlem yapmıyor ve tablo boyunca yapıyor. Örneğin Tarih sütununda 5 satır dolusu veri varsa butona basınca 5 satır dolusu işlem yapmanın yanında kalan boş satırlar içinde kafasına göre tarih yazıyor. çözemedim bir türlü nerde hata yaptığımı?

Aslında bu işlemi tablo kullanmadan yapınca sıkıntı yok ama tablo girince işin içine ozaman hata veriyor.
 
Kod:
Private Sub CommandButton1_Click()

Dim z
For z = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
Cells(z, "D").Value = Format(Cells(z, "C").Value + 3, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
Next
For z = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
Cells(z, "G").Value = Format(Cells(z, "C").Value + 11, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
Next
DUN = CDate(FormatDateTime((Now - TimeSerial(24, 0, 0)), vbShortDate)) ' bu günden bir gün oncesinin tarihini buluyor dün
    For i = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren dolu satır sayısınca döngü yapıyor
        'MsgBox CDate(FormatDateTime(Cells(i, "C").Value, vbShortDate))

   [COLOR=Red]     If Cells(i, "F").Value = "" And Cells(i, "C").Value <> "" Then[/COLOR]
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = mydate Or CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = DUN And Cells(i, "C").Value <> "" Then
        Cells(i, "E").Value = "Zaman Doldu!"
            Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
       .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535 'seçili hücre rengini sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) > mydate Then
                Cells(i, "E").Value = "Zamanı devam etmekte!"
        Range("A" & i & ":AQ" & i).Select
                With Selection.Interior
         .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0 ' seçili hücre rengini turuncu yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
      .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        Cells(i, "E").Value = "Zamanı Geçti"
        Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10498160 ' seçili hücreyi mor yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
      End With
    Selection.Font.Bold = True
                 End If
               End If
            End If
Next

Dim n
For n = 3 To Cells(Rows.Count, "C").End(3).Row ' 3. satırdan itibaren  "D" hücresi için dolu satır sayısınca döngü yapıyor
If Cells(n, "F") = "ok" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "boş" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "vazgeç" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "aktiflendi" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "süresinde iptal" Then Cells(n, "E").Value = ""
Next

Dim a
Sheets("STS").Columns(132).ClearContents
Sheets("STS").Columns(136).ClearContents
For a = 1 To [c1048576].End(xlUp).Row
If Cells(i, "F").Value = "" Then
If Cells(a, 5) = "Zaman Doldu!" Then
[eb1048576].End(xlUp).Offset(1, 0) = Cells(a, 1)
[ef1048576].End(xlUp).Offset(1, 0) = Cells(a, 2)
Range(Cells(a, 1), Cells(a, 43)).Select
                With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535   ' seçilen hücreyi sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
End If
End If
Next a
If [EB2] <> "" Then
If [EF2] <> "" Then
MsgBox "Zaman Doldu", vbInformation, "STS DESTEK"
UserForm1.Show
End If
End If

Sheets("STS").Columns(133).ClearContents
Sheets("STS").Columns(137).ClearContents
For v = 1 To [c1048576].End(xlUp).Row
If Cells(v, 6) = "vazgeç" Then
[ec1048576].End(xlUp).Offset(1, 0) = Cells(v, 1)
[eg1048576].End(xlUp).Offset(1, 0) = Cells(v, 2)
Range(Cells(v, 1), Cells(v, 43)).Interior.Color = 15773696
     With Range(Cells(v, 1), Cells(v, 43)).Font
        .Color = -16711681
        .TintAndShade = 0
    End With
End If

Next v
If [EC2] <> "" Then
If [EG2] <> "" Then
MsgBox "Vazgeçildi.", vbInformation, "STS DESTEK"
UserForm2.Show
End If
End If

Sheets("STS").Columns(134).ClearContents
Sheets("STS").Columns(139).ClearContents
For q = 1 To [c1048576].End(xlUp).Row
If Cells(q, 6) = "ok" Then
[ed1048576].End(xlUp).Offset(1, 0) = Cells(q, 1)
[ei1048576].End(xlUp).Offset(1, 0) = Cells(q, 2)
Range(Cells(q, 1), Cells(q, 43)).Interior.Color = 8641970
     With Range(Cells(q, 1), Cells(q, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With
End If

Next q
If [ED2] <> "" Then
If [EI2] <> "" Then
MsgBox "Sistem ok.", vbInformation, "STS DESTEK"
UserForm4.Show
End If
End If

For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "boş" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "ok" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 8641970
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With

End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "aktiflendi" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 4362752
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "süresinde iptal" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
End Sub


Private Sub UserForm_Click()

End Sub
Kodunuza yukarıdaki değişikliği yaparak bütün tabloya işlem yapmasını engelledim fakat tarih ekleyen kodların yerini bulamadım o yüzden onlara müdahale edemedim.
 
Kod:
Private Sub CommandButton1_Click()

Dim z
For z = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
Cells(z, "D").Value = Format(Cells(z, "C").Value + 3, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
Next
For z = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
Cells(z, "G").Value = Format(Cells(z, "C").Value + 11, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
Next
DUN = CDate(FormatDateTime((Now - TimeSerial(24, 0, 0)), vbShortDate)) ' bu günden bir gün oncesinin tarihini buluyor dün
    For i = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren dolu satır sayısınca döngü yapıyor
        'MsgBox CDate(FormatDateTime(Cells(i, "C").Value, vbShortDate))

   [COLOR=Red]     If Cells(i, "F").Value = "" And Cells(i, "C").Value <> "" Then[/COLOR]
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = mydate Or CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = DUN And Cells(i, "C").Value <> "" Then
        Cells(i, "E").Value = "Zaman Doldu!"
            Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
       .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535 'seçili hücre rengini sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) > mydate Then
                Cells(i, "E").Value = "Zamanı devam etmekte!"
        Range("A" & i & ":AQ" & i).Select
                With Selection.Interior
         .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0 ' seçili hücre rengini turuncu yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
      .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        Cells(i, "E").Value = "Zamanı Geçti"
        Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10498160 ' seçili hücreyi mor yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
      End With
    Selection.Font.Bold = True
                 End If
               End If
            End If
Next

Dim n
For n = 3 To Cells(Rows.Count, "C").End(3).Row ' 3. satırdan itibaren  "D" hücresi için dolu satır sayısınca döngü yapıyor
If Cells(n, "F") = "ok" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "boş" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "vazgeç" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "aktiflendi" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "süresinde iptal" Then Cells(n, "E").Value = ""
Next

Dim a
Sheets("STS").Columns(132).ClearContents
Sheets("STS").Columns(136).ClearContents
For a = 1 To [c1048576].End(xlUp).Row
If Cells(i, "F").Value = "" Then
If Cells(a, 5) = "Zaman Doldu!" Then
[eb1048576].End(xlUp).Offset(1, 0) = Cells(a, 1)
[ef1048576].End(xlUp).Offset(1, 0) = Cells(a, 2)
Range(Cells(a, 1), Cells(a, 43)).Select
                With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535   ' seçilen hücreyi sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
End If
End If
Next a
If [EB2] <> "" Then
If [EF2] <> "" Then
MsgBox "Zaman Doldu", vbInformation, "STS DESTEK"
UserForm1.Show
End If
End If

Sheets("STS").Columns(133).ClearContents
Sheets("STS").Columns(137).ClearContents
For v = 1 To [c1048576].End(xlUp).Row
If Cells(v, 6) = "vazgeç" Then
[ec1048576].End(xlUp).Offset(1, 0) = Cells(v, 1)
[eg1048576].End(xlUp).Offset(1, 0) = Cells(v, 2)
Range(Cells(v, 1), Cells(v, 43)).Interior.Color = 15773696
     With Range(Cells(v, 1), Cells(v, 43)).Font
        .Color = -16711681
        .TintAndShade = 0
    End With
End If

Next v
If [EC2] <> "" Then
If [EG2] <> "" Then
MsgBox "Vazgeçildi.", vbInformation, "STS DESTEK"
UserForm2.Show
End If
End If

Sheets("STS").Columns(134).ClearContents
Sheets("STS").Columns(139).ClearContents
For q = 1 To [c1048576].End(xlUp).Row
If Cells(q, 6) = "ok" Then
[ed1048576].End(xlUp).Offset(1, 0) = Cells(q, 1)
[ei1048576].End(xlUp).Offset(1, 0) = Cells(q, 2)
Range(Cells(q, 1), Cells(q, 43)).Interior.Color = 8641970
     With Range(Cells(q, 1), Cells(q, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With
End If

Next q
If [ED2] <> "" Then
If [EI2] <> "" Then
MsgBox "Sistem ok.", vbInformation, "STS DESTEK"
UserForm4.Show
End If
End If

For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "boş" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "ok" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 8641970
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With

End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "aktiflendi" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 4362752
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "süresinde iptal" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
End Sub


Private Sub UserForm_Click()

End Sub
Kodunuza yukarıdaki değişikliği yaparak bütün tabloya işlem yapmasını engelledim fakat tarih ekleyen kodların yerini bulamadım o yüzden onlara müdahale edemedim.

C sütununa manuel olarak tarih giriyorum ve dolu sütun boyunca döngü yapsın istiyorum fakat şuan sizin kırmızı ile işaretlediğiiz yeri düzeltmeme rağmen hala tablo boyunca döngü yapıyor. C sütunun dolu verisinden sonra boş kalan verilere de işlem yapıyor hala çözemedim gitti. Tablo kullanmadığım zaman hiç bir sıkıntı olmuyor.
 
Merhaba, bu sefer çözdüğümü düşünüyorum, şu kodları dener misiniz?

Kod:
Private Sub CommandButton1_Click()

Dim z
For z = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
If Cells(z, "C") <> "" Then
Cells(z, "D").Value = Format(Cells(z, "C").Value + 3, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
End If
Next
For z = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
If Cells(z, "C") <> "" Then
Cells(z, "G").Value = Format(Cells(z, "C").Value + 11, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
End If
Next
DUN = CDate(FormatDateTime((Now - TimeSerial(24, 0, 0)), vbShortDate)) ' bu günden bir gün oncesinin tarihini buluyor dün
    For i = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren dolu satır sayısınca döngü yapıyor
        'MsgBox CDate(FormatDateTime(Cells(i, "C").Value, vbShortDate))

        If Cells(i, "F").Value = "" And Cells(i, "C").Value <> "" Then
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = mydate Or CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = DUN And Cells(i, "C").Value <> "" Then
        Cells(i, "E").Value = "Zaman Doldu!"
            Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
       .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535 'seçili hücre rengini sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) > mydate Then
                Cells(i, "E").Value = "Zamanı devam etmekte!"
        Range("A" & i & ":AQ" & i).Select
                With Selection.Interior
         .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0 ' seçili hücre rengini turuncu yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
      .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        Cells(i, "E").Value = "Zamanı Geçti"
        Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10498160 ' seçili hücreyi mor yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
      End With
    Selection.Font.Bold = True
                 End If
               End If
            End If
Next

Dim n
For n = 3 To Cells(Rows.Count, "C").End(3).Row ' 3. satırdan itibaren  "D" hücresi için dolu satır sayısınca döngü yapıyor
If Cells(n, "F") = "ok" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "boş" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "vazgeç" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "aktiflendi" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "süresinde iptal" Then Cells(n, "E").Value = ""
Next

Dim a
Sheets("STS").Columns(132).ClearContents
Sheets("STS").Columns(136).ClearContents
For a = 1 To [c1048576].End(xlUp).Row
If Cells(i, "F").Value = "" Then
If Cells(a, 5) = "Zaman Doldu!" Then
[eb1048576].End(xlUp).Offset(1, 0) = Cells(a, 1)
[ef1048576].End(xlUp).Offset(1, 0) = Cells(a, 2)
Range(Cells(a, 1), Cells(a, 43)).Select
                With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535   ' seçilen hücreyi sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
End If
End If
Next a
If [EB2] <> "" Then
If [EF2] <> "" Then
MsgBox "Zaman Doldu", vbInformation, "STS DESTEK"
UserForm1.Show
End If
End If

Sheets("STS").Columns(133).ClearContents
Sheets("STS").Columns(137).ClearContents
For v = 1 To [c1048576].End(xlUp).Row
If Cells(v, 6) = "vazgeç" Then
[ec1048576].End(xlUp).Offset(1, 0) = Cells(v, 1)
[eg1048576].End(xlUp).Offset(1, 0) = Cells(v, 2)
Range(Cells(v, 1), Cells(v, 43)).Interior.Color = 15773696
     With Range(Cells(v, 1), Cells(v, 43)).Font
        .Color = -16711681
        .TintAndShade = 0
    End With
End If

Next v
If [EC2] <> "" Then
If [EG2] <> "" Then
MsgBox "Vazgeçildi.", vbInformation, "STS DESTEK"
UserForm2.Show
End If
End If

Sheets("STS").Columns(134).ClearContents
Sheets("STS").Columns(139).ClearContents
For q = 1 To [c1048576].End(xlUp).Row
If Cells(q, 6) = "ok" Then
[ed1048576].End(xlUp).Offset(1, 0) = Cells(q, 1)
[ei1048576].End(xlUp).Offset(1, 0) = Cells(q, 2)
Range(Cells(q, 1), Cells(q, 43)).Interior.Color = 8641970
     With Range(Cells(q, 1), Cells(q, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With
End If

Next q
If [ED2] <> "" Then
If [EI2] <> "" Then
MsgBox "Sistem ok.", vbInformation, "STS DESTEK"
UserForm4.Show
End If
End If

For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "boş" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "ok" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 8641970
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With

End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "aktiflendi" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 4362752
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "süresinde iptal" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
End Sub


Private Sub UserForm_Click()

End Sub
 
Merhaba, bu sefer çözdüğümü düşünüyorum, şu kodları dener misiniz?

Kod:
Private Sub CommandButton1_Click()

Dim z
For z = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
If Cells(z, "C") <> "" Then
Cells(z, "D").Value = Format(Cells(z, "C").Value + 3, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
End If
Next
For z = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
If Cells(z, "C") <> "" Then
Cells(z, "G").Value = Format(Cells(z, "C").Value + 11, "dd.mm.yyyy") ' c sutununa 3 günlük tarihi yazıyor
'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
End If
Next
DUN = CDate(FormatDateTime((Now - TimeSerial(24, 0, 0)), vbShortDate)) ' bu günden bir gün oncesinin tarihini buluyor dün
    For i = 4 To Cells(Rows.Count, "C").End(3).Row '3. satırdan itibaren dolu satır sayısınca döngü yapıyor
        'MsgBox CDate(FormatDateTime(Cells(i, "C").Value, vbShortDate))

        If Cells(i, "F").Value = "" And Cells(i, "C").Value <> "" Then
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = mydate Or CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) = DUN And Cells(i, "C").Value <> "" Then
        Cells(i, "E").Value = "Zaman Doldu!"
            Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
       .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535 'seçili hücre rengini sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        If CDate(FormatDateTime(Cells(i, "D").Value, vbShortDate)) > mydate Then
                Cells(i, "E").Value = "Zamanı devam etmekte!"
        Range("A" & i & ":AQ" & i).Select
                With Selection.Interior
         .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0 ' seçili hücre rengini turuncu yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
      .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
        Else
        Cells(i, "E").Value = "Zamanı Geçti"
        Range("A" & i & ":AQ" & i).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10498160 ' seçili hücreyi mor yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
      End With
    Selection.Font.Bold = True
                 End If
               End If
            End If
Next

Dim n
For n = 3 To Cells(Rows.Count, "C").End(3).Row ' 3. satırdan itibaren  "D" hücresi için dolu satır sayısınca döngü yapıyor
If Cells(n, "F") = "ok" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "boş" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "vazgeç" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "aktiflendi" Then Cells(n, "E").Value = ""
If Cells(n, "F") = "süresinde iptal" Then Cells(n, "E").Value = ""
Next

Dim a
Sheets("STS").Columns(132).ClearContents
Sheets("STS").Columns(136).ClearContents
For a = 1 To [c1048576].End(xlUp).Row
If Cells(i, "F").Value = "" Then
If Cells(a, 5) = "Zaman Doldu!" Then
[eb1048576].End(xlUp).Offset(1, 0) = Cells(a, 1)
[ef1048576].End(xlUp).Offset(1, 0) = Cells(a, 2)
Range(Cells(a, 1), Cells(a, 43)).Select
                With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535   ' seçilen hücreyi sarı yapıyor
        .TintAndShade = 0
        .PatternTintAndShade = 0
                End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
End If
End If
Next a
If [EB2] <> "" Then
If [EF2] <> "" Then
MsgBox "Zaman Doldu", vbInformation, "STS DESTEK"
UserForm1.Show
End If
End If

Sheets("STS").Columns(133).ClearContents
Sheets("STS").Columns(137).ClearContents
For v = 1 To [c1048576].End(xlUp).Row
If Cells(v, 6) = "vazgeç" Then
[ec1048576].End(xlUp).Offset(1, 0) = Cells(v, 1)
[eg1048576].End(xlUp).Offset(1, 0) = Cells(v, 2)
Range(Cells(v, 1), Cells(v, 43)).Interior.Color = 15773696
     With Range(Cells(v, 1), Cells(v, 43)).Font
        .Color = -16711681
        .TintAndShade = 0
    End With
End If

Next v
If [EC2] <> "" Then
If [EG2] <> "" Then
MsgBox "Vazgeçildi.", vbInformation, "STS DESTEK"
UserForm2.Show
End If
End If

Sheets("STS").Columns(134).ClearContents
Sheets("STS").Columns(139).ClearContents
For q = 1 To [c1048576].End(xlUp).Row
If Cells(q, 6) = "ok" Then
[ed1048576].End(xlUp).Offset(1, 0) = Cells(q, 1)
[ei1048576].End(xlUp).Offset(1, 0) = Cells(q, 2)
Range(Cells(q, 1), Cells(q, 43)).Interior.Color = 8641970
     With Range(Cells(q, 1), Cells(q, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With
End If

Next q
If [ED2] <> "" Then
If [EI2] <> "" Then
MsgBox "Sistem ok.", vbInformation, "STS DESTEK"
UserForm4.Show
End If
End If

For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "boş" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "ok" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 8641970
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .Color = -16776961
        .TintAndShade = 0
    End With

End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "aktiflendi" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 4362752
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
For y = 1 To [c1048576].End(xlUp).Row
If Cells(y, 6) = "süresinde iptal" Then
Range(Cells(y, 1), Cells(y, 43)).Interior.Color = 255
     With Range(Cells(y, 1), Cells(y, 43)).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End If
Next
End Sub


Private Sub UserForm_Click()

End Sub

malesef arkadaşlar bu kodda da aynı hatayı alıyorum. Anladığım kadarıyla formatlarda sorun var tarih formatında. Tarih formatlarını sildiğim zaman döngü çalışıyor fakat kafasına göre numara atıyor ilgili sütunlara
 
Merhaba,

Kod:
Cells(Rows.Count, "C").End(3).Row

Yukarıdaki komut son değeri bulurken tablonun son aralığına göre işlem yapmaktadır, bu yüzden döngü tüm satırlarda çalışmaktadır.

Kodların yukarıdaki tüm bölümlerin yerine aşağıdaki satırı yazarak deneyin. Yani sorun son satırı bulan kod bloğundadır.

Kod:
[C:C].Find("*", , , , xlByRows, xlPrevious).Row

.
 
Merhaba,

Kod:
Cells(Rows.Count, "C").End(3).Row

Yukarıdaki komut son değeri bulurken tablonun son aralığına göre işlem yapmaktadır, bu yüzden döngü tüm satırlarda çalışmaktadır.

Kodların yukarıdaki tüm bölümlerin yerine aşağıdaki satırı yazarak deneyin. Yani sorun son satırı bulan kod bloğundadır.

Kod:
[C:C].Find("*", , , , xlByRows, xlPrevious).Row

.

hocam malesefm yine olmadı :(

hata mesajını ekte resim olarak koydum. Sanırım formatı ile alakalı. Ben Textboxlarla C hücresine tarih yazdırıyorum. Daha sonra buton yardımı ile D ve G sütunlarına +3 gün ve +11 gün ekletiyorum fakat +3 ve +11 eklerken format hatası veriyor sanırım tarih formatı ile alakalı ama niye veriyor anlamıyorum sonuçta doğru formatta tarih üstelik ilgili hücrede tarih formatında çözemedim bir türlü ya :( Formatı değiştirince döngü çalışıyor fakat kafasına göre sayı belirliyor.
 

Ekli dosyalar

  • hata.jpg
    hata.jpg
    18.6 KB · Görüntüleme: 5
Son düzenleme:
Kod:
Sub kapatma()
Dim z
For z = 4 To [C:C].Find("*", , , , xlByRows, xlPrevious).Row '4. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
[COLOR="Red"]Cells(z, "D").Value = Format(Cells(z, "C").Value + 3, "dd.mm.yyyy")[/COLOR] ' c sutununa 3 günlük tarihi yazıyor
                                                                               'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
Next
For z = 4 To [C:C].Find("*", , , , xlByRows, xlPrevious).Row '4. satırdan itibaren  "C" hücresi için dolu satır sayısınca döngü yapıyor
[COLOR="red"]Cells(z, "G").Value = Format(Cells(z, "C").Value + 11, "dd.mm.yyyy")[/COLOR] ' c sutununa 3 günlük tarihi yazıyor
                                                                               'MsgBox Format(Cells(s, "B").Value, "dd.mm.yyyy")
Next
End Sub

Arkadaşlar Textbox yardımı ile tarih formatında "C" sütununa veri yazdırıyorum ve burdaki veriye göre de "D" ve "G" sütunlarına yine tarih formatında veri hesaplatıyorum. Aldığım hata da bu formatlarla alakalı. Çünkü ben textbox yazdırdığım veriyi ilgili hücrenin içine girip enterladıktan sonra veya F2 yapıp düzelttiğimde buton çalışıyor ve hesaplamaları yapıyor. Kırmızı ile işaretlediğim satırda anlamadığım textbox tarih formatında yazdırdığım veriyi neden sistem algılamıyor ve hesaplama yapmıyor. Destek olabilecek var mı?
 
Son düzenleme:
bu formata çare bulacak biri yokmu arkadaşlar ? Yaptığım tüm iş çöpe gidecek malesefki çözüm üretemezsem ilerleyemeyeceğim :(
 
Verinizin tipini aşağıdaki şekilde Tarih olarak belirtmeyi deneyiniz.

Cells(z, "G").Value = CDate(Format(Cells(z, "C").Value + 11, "dd.mm.yyyy"))
 
Verinizin tipini aşağıdaki şekilde Tarih olarak belirtmeyi deneyiniz.

Cells(z, "G").Value = CDate(Format(Cells(z, "C").Value + 11, "dd.mm.yyyy"))

hocam valla yine olmadı yine aynı yerde hata veriyor sizin yukarda vermiş olduğunuz satırda aynı htayı veriyor. Konu ile ilgili örnek dosya ekledim. Şimdi ben Form1 de yeni kayıt oluşturuyorum ve Form2 de "+3 ve +11 Tarih atama" butonlarıyla C sütunundaki tarih verisine göre D ve G sütunlarına +3 ve +11 gün atmasını istiyorum fakat sistem bir türlü formatı tanımadığı için hata veriyor. Formatla ilgili niye bu kadar sıkıntı yaşıyor anlamadım. Şöyle bir durum var şayet ben hücrelerin içine girip F2 ve ente işlemi yapınca sistem tam anlamıyla sorunsuz çalışıyor. Sanırım sorunun çözümü F2 ve enter işlemleri ile çözülecek gibi fakat ben onuda denedim makro ile F2+enter yaptırdım bu seferde dolu satır boyunca yapmıyor yani döngü sonsuz döngüye giriyor sürekli çalışıyor ve hiç bir işlem yapmıyor. Çıldırıcam olmadı bir türlü ya allah rızası için yardım diliyorum çözebilecek arkadaşlardan :( dosya ekte
 

Ekli dosyalar

Tarih formatı için aşağıdaki gibi kullanmanız yeterli olacaktır.

Kod:
Cells(sonsat, 3) = CDate(TextBox3)
 
Korhan Hocam yanıtlamışlar aslında.
Yine de dosyanıza bakmak açısından, dosyanızı xls formatında ekleyebilir misiniz. 2003 kullanmaktayımda.
 
Korhan Hocam yanıtlamışlar aslında.
Yine de dosyanıza bakmak açısından, dosyanızı xls formatında ekleyebilir misiniz. 2003 kullanmaktayımda.

Kusura bakmayın biraz geç cevap verdim malum iş hayatı anca geldim eve :)

hocam dosyayı ekledim bakabilir misiniz?
 

Ekli dosyalar

Geri
Üst