kod güncelleme

[igultekin2000]

iyi akşamlar;

Sub KODMOD_1()
    Application.ScreenUpdating = False
        For i = 2 To Cells(Rows.Count, "C").End(3).Row
        If Cells(i, "E") = "" And Cells(i, "F") <> "" And Cells(i, "G") = "" Then
            Cells(i, "G") = Cells(i + 1, "G")
      End If
          Next i
    i = Empty
          For i = Cells(Rows.Count, "C").End(3).Row To 2 Step -1
         If Cells(i, "E") <> "" And Cells(i, "F") = "" And Cells(i, "G") = "" Then
            Cells(i, "G") = Cells(i + 1, "G")
       End If
         Next i
         i = Empty
             Application.ScreenUpdating = True
End Sub

ve

Sub KODMOD_2()
 Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
        For i = 2 To Cells(Rows.Count, "C").End(3).Row
        If Cells(i, "E") = "" And Cells(i, "F") <> "" And Cells(i, "G") = "" Then
            Cells(i, "G") = Cells(i - 1, "G")
      End If
          Next i
    i = Empty
          For i = Cells(Rows.Count, "C").End(3).Row To 2 Step -1
         If Cells(i, "E") <> "" And Cells(i, "F") = "" And Cells(i, "G") = "" Then
            Cells(i, "G") = Cells(i - 1, "G")
       End If
         Next i
         i = Empty
             Application.ScreenUpdating = True
              Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic

End Sub

bu iki makroda da G= M,T,O ise işlem yapmasın seçeneği ilave etmek istiyorum. Teşekkürler.

 

[Saban Sertkaya]

Merhabalar, isteğinizi tam anlayamamakla birlikte aşağıdaki şekilde bir deneyin. Eğer işinizi görüyorsa aynı mantığı 2.kod bloğunuz içinde yapabilirsiniz.

Sub KODMOD_1()
    Application.ScreenUpdating = False

        For i = 2 To Cells(Rows.Count, "C").End(3).Row
            [COLOR="Red"]If cells(i,"G") = cells(i,"M") or cells(i,"G") = cells(i,"T") or cells(i,"G") = cells(i,"O") then goto 10[/COLOR]
            If Cells(i, "E") = "" And Cells(i, "F") <> "" And Cells(i, "G") = "" Then
            Cells(i, "G") = Cells(i + 1, "G")
            End If
            [COLOR="red"]10[/COLOR]
        Next i
        i = Empty

       'i = empty yazmak yerine 2.for döngüsünde başka bir değişken kullanmanız daha anlaşılır olurmuş.

        For i = Cells(Rows.Count, "C").End(3).Row To 2 Step -1
            [COLOR="red"]If cells(i,"G") = cells(i,"M") or cells(i,"G") = cells(i,"T") or cells(i,"G") = cells(i,"O") then goto 20[/COLOR]
            If Cells(i, "E") <> "" And Cells(i, "F") = "" And Cells(i, "G") = "" Then
            Cells(i, "G") = Cells(i + 1, "G")
            End If
            [COLOR="red"]20[/COLOR]
       Next i
       i = Empty

      Application.ScreenUpdating = True
End Sub

 

[igultekin2000]

Sorum eksik

Merhabalar, isteğinizi tam anlayamamakla birlikte aşağıdaki şekilde bir deneyin. Eğer işinizi görüyorsa aynı mantığı 2.kod bloğunuz içinde yapabilirsiniz.

Sorumu okuyunca açık olmadığını gördüm, ilave açıklama yapmam gerekiyor. işleme mantığı G sütununda kodlar var. Bu makro bu kodları yukarı ve aşağı kopyalıyor. G hücresinde M - T - O olduğunda bunları yukarı-aşağı kopyalamasın istiyorum. Sadece diğer Kodların aşağı yukarı kopyalanması;

 

[Saban Sertkaya]

Altın üye olmadığımızdan eklediğiniz resmi göremiyorum. Haliyle eklediğiniz resmi görmeyince M - T - O ile ne anlatmak istediğiniz tam anlaşılmıyor. G hücresinde M - T - O birlikte yazılan bir veri midir ? Yoksa G hücresinde sadece M, sadece T veya sadece O yazdığında mı işlem yapılmayacaktır ? İkinci seçenek ise aşağıdaki şekilde bir deneyin.

Sub KODMOD_1()
    Application.ScreenUpdating = False

        For i = 2 To Cells(Rows.Count, "C").End(3).Row
            If cells(i,"G") = "M" or cells(i,"G") = "T" or cells(i,"G") = "O" then goto 10
            If Cells(i, "E") = "" And Cells(i, "F") <> "" And Cells(i, "G") = "" Then
            Cells(i, "G") = Cells(i + 1, "G")
            End If
            10
        Next i

        For a = Cells(Rows.Count, "C").End(3).Row To 2 Step -1
            If cells(a,"G") = "M" or cells(a,"G") = "T" or cells(a,"G") = "O" then goto 10
            If Cells(a, "E") <> "" And Cells(a, "F") = "" And Cells(a, "G") = "" Then
            Cells(a, "G") = Cells(a + 1, "G")
            End If
            20
       Next a

      Application.ScreenUpdating = True
End Sub