Makronun yapılacağı işleme göre Sütun ve Veri Değişikliği..!

[sensizsoldum]

Merhaba,
Aşağıdaki kodda minik bir değişiklik yapılarak başka çalışma da farklı yer için kullanmak istiyorum. Sütun ve silinmesini istemediğim verileri yazıyorum sonuç olumsuz acaba kodlar arasında başka nereyi değiştirmem gerekiyor. Kodun çalışma özelliğiB3:B sütun aralığında MH, MB MD ile verileri satır olarak silmesi.
Ben bunu G3:G arasında 2 ve 3 olan veriler diğer ne varsa onları satır olarak silsin istiyorum.
Kodlar Sayın Korhan Bey in kalemindendir.

ORJİNAL HALİ

Sub SATIR_SİL()
Dim Veri(), X, dizi(), Alan As Range, SATIR As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

SATIR = Cells(Rows.Count, 2).End(3).Row
If SATIR < 3 Then Exit Sub

If SATIR = 3 Then
If UCase(Left(Cells(SATIR, "B"), 2)) <> "MB" And _
UCase(Left(Cells(SATIR, "B"), 2)) <> "MD" And _
UCase(Left(Cells(SATIR, "B"), 2)) <> "MH" Then
Rows(SATIR).Delete
End If
Else

Veri = Range("B3:B" & SATIR).Value

ReDim dizi(UBound(Veri))

For X = 1 To UBound(Veri)
dizi(X) = Veri(X, 1) & "#B" & X + 2
Next

For X = 3 To UBound(dizi) + 2
If UCase(Left(dizi(X - 2), 2)) <> "MB" And _
UCase(Left(dizi(X - 2), 2)) <> "MD" And _
UCase(Left(dizi(X - 2), 2)) <> "MH" Then
If Alan Is Nothing Then
Set Alan = Range(Split(dizi(X - 2), "#")(1))
Else
Set Alan = Application.Union(Alan, Range(Split(dizi(X - 2), "#")(1)))
End If
End If
Next

If Not Alan Is Nothing Then
Alan.EntireRow.Delete
End If
End If

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub






DEĞİŞTİRİLMİŞ HALİ

Sub SATIR_SİL()
Dim Veri(), X, dizi(), Alan As Range, SATIR As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

SATIR = Cells(Rows.Count, 2).End(3).Row
If SATIR < 3 Then Exit Sub

If SATIR = 3 Then
If UCase(Left(Cells(SATIR, "G"), 2)) <> "2" And _
UCase(Left(Cells(SATIR, "G"), 2)) <> "3" Then
Rows(SATIR).Delete
End If
Else

Veri = Range("B3:B" & SATIR).Value

ReDim dizi(UBound(Veri))

For X = 1 To UBound(Veri)
dizi(X) = Veri(X, 1) & "#G" & X + 2
Next

For X = 3 To UBound(dizi) + 2
If UCase(Left(dizi(X - 2), 2)) <> "2" And _
UCase(Left(dizi(X - 2), 2)) <> "3" Then
If Alan Is Nothing Then
Set Alan = Range(Split(dizi(X - 2), "#")(1))
Else
Set Alan = Application.Union(Alan, Range(Split(dizi(X - 2), "#")(1)))
End If
End If
Next

If Not Alan Is Nothing Then
Alan.EntireRow.Delete
End If
End If

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Korhan Ayhan]

Merhaba,

Lütfen alıntı kodlarınızı foruma eklerken "CODE" tagını kullanın. Bu şekilde kodlar daha derli toplu görünmektedir.

Mesaj yazma penceresindeki menüde # şeklinde gördüğünüz sembol ile bu işlemi yapabilirsiniz.

Sub SATIR_SİL()
    Dim Veri(), X, Dizi(), Alan As Range, Satir As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Satir = Cells(Rows.Count, "G").End(3).Row
    If Satir < 3 Then Exit Sub
    
    If Satir = 3 Then
        If Left(Cells(Satir, "G"), 1) <> "2" And _
        Left(Cells(Satir, "G"), 1) <> "3" Then
            Rows(Satir).Delete
        End If
    Else
    
        Veri = Range("G3:G" & Satir).Value
        
        ReDim Dizi(UBound(Veri))
        
        For X = 1 To UBound(Veri)
            Dizi(X) = Veri(X, 1) & "#G" & X + 2
        Next
        
        For X = 3 To UBound(Dizi) + 2
            If Left(Dizi(X - 2), 1) <> "2" And _
            Left(Dizi(X - 2), 1) <> "3" Then
                If Alan Is Nothing Then
                    Set Alan = Range(Split(Dizi(X - 2), "#")(1))
                Else
                    Set Alan = Application.Union(Alan, Range(Split(Dizi(X - 2), "#")(1)))
                End If
            End If
        Next
        
        If Not Alan Is Nothing Then
            Alan.EntireRow.Delete
        End If
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[sensizsoldum]

Merhaba Korhan Bey,
Günaydın Hayırlı sabahlar,
İlginiz için teşekkür ederim. Çok hızlı ve güzel oldu, elinize, bilginize sağlık. Bundan sonraki konulara eklenecek kodlara daha da dikkat ederim
Tekrardan teşekkür ederim iyi çalışmalar dilerim.
Saygılarımla.

 

[sensizsoldum]

Günaydın Korhan Bey,
Yukarıda değişiklik yapılan kodu başka bir sayfada yine kullanma ihtiyacım var, ama bu kez G2:G aralığına göre 2 ve 3 haricinde diğer verileri satır olarak silmesi gerekiyor. Ben sırasıyla komple ve hemen hemen her şekilde aşağıdaki bölümleri 2 olarak değiştirdim. Sonucunda bazen hata aldım. Bazen işlemi yaptı ama yine G3:G aralığına göre yaptı. Yapıp yapabileceğim her yolu yordamı denedim başarısız oldum. Ne gibi bir değişiklik yapılması gerekiyor. Konuyu aydınlatabilirseniz çok memnun olurum.
İyi çalışmalar dilerim.


Veri = Range("G3:G" & Satir).Value

If Satir < 3 Then Exit Sub
If Satir = 3 Then
For x = 3 To UBound(Dizi) + 2