Benzer Kayıtları içeren satırları silme!

[ocamsul]

Arkadaşlar merhabalar ekli çaılşmada kolaylık olması anlamında renklendirilmiş sütundaki numaraların aynı olması durumunda; tek bir kaydın kalması ve benzer kayıtları içeren satırların silinmesini bir makro ile düzenlemek istiyorum. bu konuda yardımlarınızı bekliyorum.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kod sadece E sütununa göre mükerrer olan kayıtları teke indirir.

Sub MÜKERRER_KAYITLARI_TEKE_İNDİR()
    For X = [E65536].End(3).Row To 1 Step -1
    If WorksheetFunction.CountIf(Range("E8:E" & X), Cells(X, "E")) > 1 Then Rows(X).Delete
    Next
End Sub

 

[ocamsul]

Sn: COST_CONTROL

Çok Teşekkür Ederim Usta eline sağlık...

 

[ocamsul]

Arkadaşlar, bu işlemi farklı bir makro ile bir başka buton yardımıyla Örneğin B sütununa has bir makro düzenlemek istiyorum. kodlarda hangi bölümlerde neler yapmam lazım.

 

[ocamsul]

Cevap yokmu dostlar?

 

[ocamsul]

Aşağıdaki kodları farklı bir makro ile bir başka sütun için de uygulamak istiyorum. bu kodların nerelerinde düzeltme yada ekleme yapmam gerekli arkadaşlar?

Kod:
Sub MÜKERRER_KAYITLARI_TEKE_İNDİR()
For X = [E65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("E8:E" & X), Cells(X, "E")) > 1 Then Rows(X).Delete
Next
End Sub

 

[orcunerkek54]

komut tek butonda olsun istiyorsan

Private Sub CommandButton1_Click()
For X = [E65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("E8:E" & X), Cells(X, "E")) > 1 Then Rows(X).Delete
Next

For X = [b65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("b8:b" & X), Cells(X, "b")) > 1 Then Rows(X).Delete
Next
End Sub
şeklinde yaz başkada ilave etmek istersen nereyi istiyorsan oranın sütun harfiyle koddaki bütün harflerin yerini değişirsen bu iş olur

 

[ocamsul]

verilen kodları değiştirdim ancak B sütununda boş alan var ise silmedi!

 

[Ali]

Sanırım B sütununda isim yoksa o satırı silmek istiyorsunuz.Eğer doğru anladım ise aşağıdaki kodları kullanın.

Sub boşlarısil()
    Application.ScreenUpdating = False
        Dim i As Integer
            For i = [B65536].End(3).Row To 4 Step -1
                If IsEmpty(Cells(i, 2)) Then
            Rows(i).Delete
        End If
   Next i
Application.ScreenUpdating = True
End Sub

 

[ocamsul]

Sn: fructose

Teşekkür Ederim. Sorunum kodlarınızla çözüldü. Sağolun.

 

[Ali]

Hangi örnek Telefon03 diye eklediğinizmi Telefon04 diye eklediğinizmi..

ilk eklediğiniz dosyadan Telefon03 yani eğer onun için ise

Sub boşlarısil()
    Application.ScreenUpdating = False
        Dim i As Integer
            For i = [C65536].End(3).Row To 8 Step -1
                If IsEmpty(Cells(i, 3)) Then
            Rows(i).Delete
        End If
   Next i
Application.ScreenUpdating = True
End Sub

şeklinde deneyin.

 

[Ali]

Bende değiştirmiştim ama siz sorunu çözmüşsünüz sanırım.İyi çalışmalar.

 

[onur79]

slm

Benim b sütümda firma isimleri var en son girelilen kalacak eski silecek şekilde nasıl düzenleyeceğim.

Yardimci olursanız sevinirm