hücre temizleme

[meda58]

arkadaşlar ekdeki dosyada BÜYÜK TARİFE isimli sayfada AH sütünunda verilerin tamamı seçilip içerik temizlenince dolu hücrelerin karşılığındaki A sütünundaki verilerde içerik temizlensin istiyorum yardımlarınızı bekliyorum

sarıları sil butonuna basınca AH sütünundaki veriler otamatikman temizleniyor dikkatinize sunuyorum

VB şifresi 145314

 

[Levent Menteşoğlu]

VB editörünüz şifreli.

 

[meda58]

çok çok özür dilerim şifre 145314
bir türlü yapamadım incelerseniz sevinirim

 

[Levent Menteşoğlu]

BÜYÜK TARİFE sayfasının kod sayfasındaki kodları aşağıdaki ile değiştirerek denermisiniz. Kırmızı renkli kısımlar ilave edilmiştir.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
Application.EnableEvents = False
 
[COLOR=red]If Not Intersect(Target, [ah6:ah55]) Is Nothing Then
If Target = "" Then
sat = Target.Row
Cells(sat, "a") = ""
End If
GoTo 10
End If[/COLOR]

If Not Intersect(Target, Range("r5:s" & [B65536].End(3).Row)) Is Nothing Then
If Target = "" Then Exit Sub
If Cells(Target.Row, "r") = Cells(Target.Row, "s") Then
Range(Cells(Target.Row, "q"), Cells(Target.Row, "s")).Interior.ColorIndex = 6
Else
Range(Cells(Target.Row, "q"), Cells(Target.Row, "s")).Interior.ColorIndex = xlNone
End If
End If
If Not Intersect(Target, Range("p5:p" & [B65536].End(3).Row)) Is Nothing Then
Range(Cells(Target.Row, "q"), Cells(Target.Row, "s")).Interior.ColorIndex = xlNone
Range(Cells(Target.Row, "r"), Cells(Target.Row, "s")).ClearContents
End If
Son:
If WorksheetFunction.CountA(Columns(1)) = 0 Then
Range("r" & Target.Row & ":s" & [B65536].End(3).Row).ClearContents
End If
[COLOR=red]10[/COLOR] Application.EnableEvents = True
End Sub

 

[meda58]

hocam AH deki hücreleri tek tek secip temizleyince kod çalışıyor fakat benim istediğim sarıları sil butonuna basınca AH sütünunda secilerek otamatikman temizleniyor ozaman bu makro çalışmıyor bana sarıları sil butonuna basınca çalışan makro lazım şimdiden ilginize teşekkürler
AH sütünu komple seçip temizleyince eklemenin çalışması lazım

 

[Levent Menteşoğlu]

Yukarıda verdiğim ilave sarıları sil butonuna bastığınızda A sütunundaki verileride silecektir. Denemede hata yapmış olabilirsiniz.

 

[meda58]

hocam butonla ve elle tekrar tekrar denedim fakat olmadı

 

[Levent Menteşoğlu]

Ekli dosyayı inceleyin.

 

[meda58]

hocam A sütünu nasıl sarı renk oldu anlamadım oranın renkli olmaması lazım
AH6-AH55 aralığı seçilip temizlenince dolu hücrelerin karşılığı A sütünuda silinmeli

 

[Levent Menteşoğlu]

Hücreleri ben renklendirdim. AH sütununu sildiğinizde karşılığındaki sarı hücrelerinde silindiğini görebilmeniz için.

 

[meda58]

hocam AH stünunda hücreleri tek tek seçip temizleyince makro çalışıyor onda bir sorun yok fakat benim istediğim hepsini birden seçip temizleyince AH sütünundaki dolu hücrelerin karşılığında bulunan A sütünundaki verinin temizlenmesi hiç bir butonu devreye sokmayalım el ile şecip temizleme yapalım

 

[Levent Menteşoğlu]

hocam AH stünunda hücreleri tek tek seçip temizleyince makro çalışıyor onda bir sorun yok fakat benim istediğim hepsini birden seçip temizleyince AH sütünundaki dolu hücrelerin karşılığında bulunan A sütünundaki verinin temizlenmesi hiç bir butonu devreye sokmayalım el ile şecip temizleme yapalım

Bu durumda silme işlemini direk silme koduna yazalım. Yukarıda verdiğim ilaveleri dosyanızadan kaldırın ve SARILARI_SİL prosedürünü aşağıdaki ile değiştirin.

Private Sub SARILARI_SİL()
For Each hucre In [a6:a77,d6:d77,f6:f77,h36:h75,j5:j75,l5:l75,n5:n67,p5:p67]
If hucre.Interior.ColorIndex = 6 Then hucre.ClearContents
Next
For a = 5 To 55
If Cells(a, "ah") <> "" Then
Cells(a, "a") = ""
End If
Cells(a, "ah") = ""
Next
MsgBox "İŞLEM TAMAMLANDI"
End Sub

 

[meda58]

hocam önünüzde saygı ve hürmetle eğiliyorum şu an mükemmel çalışıyor allah razı olsun bakış açısının ve düşünce yapısının ne kadar önemli olduğunun bir kez daha farkına vardım

affınıza sığınarak birşey daha sormak istiyorum işlemleri daha hızlandırmanın yolu varmıdır

 

[Levent Menteşoğlu]

hocam önünüzde saygı ve hürmetle eğiliyorum şu an mükemmel çalışıyor allah razı olsun bakış açısının ve düşünce yapısının ne kadar önemli olduğunun bir kez daha farkına vardım

affınıza sığınarak birşey daha sormak istiyorum işlemleri daha hızlandırmanın yolu varmıdır

Rica ederim. Hızlandırmak derken konuyu biraz daha açmanızı rica edeceğim. Yaptığınız işlemleri yazabilirseniz ona göre yeni çözümler üretilebilir.

 

[meda58]

hocam makroların çogunu deneme yanılma ve kayıt yöntemiyle yaptım bunları daha basitleştirmenin ve hızlandırmanın yolu yokmu

 

[bunyamin07]

Merhaba

Bu Programın Çok daha basiti yok mu?
Sadece C2:C16 , D2:d15 ve E2 : E10 arasını silecek bir koda ihtiyacım var..

Tabi butonu o koda nasıl bağlayacağımıda yazarsanız minnettar kalırım.

 

[bunyamin07]

Yardım eden yok mu?

Bu Programın Çok daha basiti yok mu?
Sadece C2:C16 , D2:d15 ve E2 : E10 arasını silecek bir koda ihtiyacım var..

Tabi butonu o koda nasıl bağlayacağımıda yazarsanız minnettar kalırım.

Eminim bu konuda yardım edecek birileri vardır.

 

[bunyamin07]

Kodu buldum bari biri bana bunu nasıl bir butona bağlarım onu söylesin..
Sub Seçileni_Temizle()
Sheets("sayfa1").Range("c2:e14").ClearContents
End Sub

 

[redje]

merhaba
Option Compare Text

Sub sil()
Sheets("sayfa1").Range("c2:e14").ClearContents
End Sub

merhaba
yukardaki gibi makroyu oluşturduktan sonra
ofis 2010 için geliştirici denetim ekle kısmından ilk olanı seç makro ata çıkar
sil makrosunu ata işini görür

 

[bunyamin07]

Çok saol

merhaba
Option Compare Text

Sub sil()
Sheets("sayfa1").Range("c2:e14").ClearContents
End Sub

merhaba
yukardaki gibi makroyu oluşturduktan sonra
ofis 2010 için geliştirici denetim ekle kısmından ilk olanı seç makro ata çıkar
sil makrosunu ata işini görür

Çok teşekkür ederim.