• DİKKAT

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

Kod revize (Sütun silindiğinde kod çalışmıyor)

S.Yiğit

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2008
Mesajlar
1,748
Excel Vers. ve Dili
2019 TR
Merhabalar,

Ekteki çalışmamda sütun sildiğimde makro çalışmıyor. kodda değişklik yapmam gerekiyor ama nasıl yapacağımı bilmiyorum. Örnek ekteki çalışmada I-J sütunlarını silmem gerekiyor. Sildiğimde kod çalışmıyor.

Kodun yaptığı ise Gerçekleşen sayfasında Gerçekleşen başlagıç tarihi ile Gerçekleşen bitiş tarihi aralığını SV Özet sayfasında boyuyor. Kod gayet güzel çalışıyor ama bu tablo yeni yapıldığı ve sürekli geliştiği için aralara sütun eklememiz veya kaldırmamız gerekiyor. Kodda yapılacak değişiklikle ilgili kısa bilgi verirseniz ilerde kendim yaparım.
 

Ekli dosyalar

Merhaba,
2007 yüklü olmadığı için deneyemiyorum. Ama sizi yönlendireyim düzenlemenizi ona göre yapın. I ve J sütunlarını sildiğiniz zaman tablonuz 2 sütun sola kayacak anlamına geliyor. Dolayısıyla M sütunu K'ye N sütunu L'ye denk geliyor. Kodlarınız bu sütunlara başvuran düzenlemelere sahipse doğal olarak kod aradığını bulamayacak ve kod çalışmayacaktır. Sildiğiniz sütundan itibaren Jsütunundan sonra gelen sütunları iki sola kaydıracak şekilde kodları düzenlemlisiniz. Örneğin kodlarınızın aşağıda belirttiğim kısmını yanlarında belirttiğim şekilde düzenlemlisiniz. Benim görebildiklerim bunlar. Gözden kaçan kısımlar olmaması için kodlarınızı iyice kontrol edin.
Kod:
If IsDate(Sheets("GERÇEKLEŞEN").Cells(i, "k").Value) = True Then [COLOR="DarkGreen"]'K'yi "I" yapmalısınız.[/COLOR]
If IsNumeric(Sheets("GERÇEKLEŞEN").Cells(i, "L").Value) = True Then [COLOR="darkgreen"]'L'yi "J" yapmalısınız.[/COLOR]
aranan2 = Sheets("GERÇEKLEŞEN").Cells(i, "k").Value [COLOR="darkgreen"]'K'yi "I" yapmalısınız.[/COLOR]
aranan3 = Sheets("GERÇEKLEŞEN").Cells(i, "l").Value - 1 [COLOR="darkgreen"]'L'yi "J" yapmalısınız.[/COLOR]
 
Hocam merhaba,

Öncelikle anlatımınız için teşekkür ederim. Dediğiniz şekilde yapınca oldu. İnşallah ileride bir sorunla karşılaşmam. İncelemeniz için 2003 formatında ekledim. İyi çalışmalar dilerim.
 

Ekli dosyalar

Serkan Bey,
2007'yi açıp çalıştırabiliyorum. Onda sıkıntı yok. Tablonuz 256 sütundan fazla olduğu için kodlarınız bende hata veriyor. Yinede sorun olursa yardımcı olmaya çalışırım. Bu gidişle 2007'yi yeniden kuracağım,gidişat onu gösteriyor.
 
Merhaba,

Ekteki çalışma için H sütununu kesip E ve F sütunu arasına koymam gerekiyor.

Bu işlemi yaptığımda F sütunu G, G sütunu da H sütunu oluyor. Makro kodunda nasıl bir değişiklik yapmam lazım.

Birde sormak istediğim, Bu gibi değişiklikler için makro yok mu? Sütun sildiğimde makro kodlarını revize edecek bir kod? Çalışma yeni ve sürekli geliştiği için bu değişiklikler sürekli olacak.

Yardımcı olacaklara şimdiden tşkler..
 

Ekli dosyalar

Merhaba,

Ekteki çalışma için H sütununu kesip E ve F sütunu arasına koymam gerekiyor.

Bu işlemi yaptığımda F sütunu G, G sütunu da H sütunu oluyor. Makro kodunda nasıl bir değişiklik yapmam lazım.

Birde sormak istediğim, Bu gibi değişiklikler için makro yok mu? Sütun sildiğimde makro kodlarını revize edecek bir kod? Çalışma yeni ve sürekli geliştiği için bu değişiklikler sürekli olacak.

Yardımcı olacaklara şimdiden tşkler..

Bunu denermisiniz.

Kod:
Sub aktar3()
Worksheets("SV ÖZET").Rows("5:22").FormatConditions.Delete
Worksheets("SV ÖZET").Rows("5:22").ClearContents
sut = Worksheets("SV ÖZET").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
sat = 5
tedarikci = [COLOR=red]"h"
[/COLOR]baslangictarih = [COLOR=red]"I"
[/COLOR]montajtarih = [COLOR=red]"g"
[/COLOR]montajsure = [COLOR=red]"j"
[/COLOR]son1 = Worksheets("GERÇEKLEŞEN").Cells(Rows.Count, tedarikci).End(3).Row
For r = 3 To son1
aranan1 = Sheets("GERÇEKLEŞEN").Cells(r, tedarikci).Value
deg = 0
If aranan1 <> "" Then
If WorksheetFunction.CountIf(Worksheets("GERÇEKLEŞEN").Range(tedarikci & "3:" & tedarikci & r), aranan1) = 1 Then
For i = r To son1
aranan2 = Sheets("GERÇEKLEŞEN").Cells(i, baslangictarih).Value
aranan3 = Sheets("GERÇEKLEŞEN").Cells(i, montajsure).Value
aranan4 = Sheets("GERÇEKLEŞEN").Cells(i, tedarikci).Value
aranan5 = Sheets("GERÇEKLEŞEN").Cells(i, montajtarih).Value
If aranan5 = "SV ÖZET" Then
If IsDate(aranan2) = True Then
If IsNumeric(aranan3) = True Then
If aranan1 = aranan4 Then
For n = 2 To sut
If aranan2 = Sheets("SV ÖZET").Cells(4, n).Value Then
deg = 1
Sheets("SV ÖZET").Cells(sat, 1).Value = aranan4
For j = n To aranan3 + n - 1
Sheets("SV ÖZET").Cells(sat, j).FormatConditions.Delete
Sheets("SV ÖZET").Cells(sat, j).FormatConditions.Add Type:=xlExpression, Formula1:="=r" & sat & "c" & j & ">0"
Sheets("SV ÖZET").Cells(sat, j).FormatConditions(1).Interior.ColorIndex = 3
If Sheets("SV ÖZET").Cells(sat, j).Value = "" Then
Sheets("SV ÖZET").Cells(sat, j).Value = Sheets("GERÇEKLEŞEN").Cells(i, 1).Value
Else
Sheets("SV ÖZET").Cells(sat, j).Value = "iki iş var "
Sheets("SV ÖZET").Cells(sat, j).FormatConditions(1).Interior.ColorIndex = 6
End If
Next j
Exit For
End If
Next n
End If
End If
End If
End If
Next i
End If
End If
If deg = 1 Then
sat = sat + 1
End If
Next r
MsgBox "İŞLEM TAMAM"
End Sub
 
Hocam merhaba,

Kod için teşekkür ederim. Sanırım sütun silme gibi işlemlerde kodu revize edecek bir kod yok. İnşallah bundan sonra sütun ekleme işi çıkmaz yoksa tekrar yardım isteyeceğim. Tekrar teşekkürler.
 
Geri
Üst