eşleşen satırların silinmesi

[igultekin2000]

iyi günler; daha önce kullandığım makro' yu yeni çalışma sayfasında kullanamıyorum. Eşleşen satırları silmesi gerekirken, farklı satırları siliyor.

Sub SATIR_SIL()
Set wf = Application.WorksheetFunction
Application.DisplayAlerts = False
For sat = 2 To Cells(Rows.Count, 1).End(3).Row
    If Cells(sat, "F") > 0 And wf.CountIf(Range("G:G"), Cells(sat, "F")) > 0 Then
        gsat = wf.Match(Cells(sat, "F"), Range("G:G"), 0)
        Range("A" & sat & ":J" & sat).Delete Shift:=xlUp
        If sat < gsat Then gsat = gsat - 1
        Range("A" & gsat & ":J" & gsat).Delete Shift:=xlUp
        sat = sat - 1
    End If
Next
Application.DisplayAlerts = True
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
End Sub

 

[Asri]

F ve G de sayı olmayan hücrelerde tanımsız karakter mevcut.
İlk aşamada onlar temizleniyor.


Deneyiniz.

Sub SATIR_SIL()
Set wf = Application.WorksheetFunction
Application.DisplayAlerts = False
Columns("F:G").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
    Range("F5").Select
    
sonsatir = Cells(Rows.Count, 1).End(3).Row
For sat = sonsatir To 2 Step -1
    gsat = 0
    If Cells(sat, "F").Value > 0 And wf.CountIf(Range("G:G"), Cells(sat, "F").Value) > 0 And Replace(Cells(sat, "F").Value, " ", "") <> "" Then
       gsat = wf.Match(Cells(sat, "F").Value, Range("G:G"), 0)
    End If
    If Cells(sat, "G").Value > 0 And wf.CountIf(Range("F:F"), Cells(sat, "G").Value) > 0 And Replace(Cells(sat, "G").Value, " ", "") <> "" Then
       gsat = wf.Match(Cells(sat, "G").Value, Range("F:F"), 0)
    End If

    If gsat > 0 Then
        Range("A" & sat & ":J" & sat).Delete Shift:=xlUp
        Range("A" & gsat & ":J" & gsat).Delete Shift:=xlUp

        sat = sat - 1
    End If
Next
Application.DisplayAlerts = True
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
End Sub

 

[igultekin2000]

sorun çözülmedi

iyi günler; verdiğiniz kodu uyguladım ama sorun çözülmedi, belirttiğiniz gibi sayı olmayın değerler var dediğiniz için daha önce bu siteden aldığım

Sub Dene()
    Cells.Replace Chr(160), ""
    For Each huc In ActiveSheet.UsedRange
        huc.Value = Trim(huc.Value)
    Next

End Sub

Sub çevir()
Dim x As Range
For Each x In [F1:G500]
If x.Value <> "" Then
If IsNumeric(x.Value) = True Then
x.Value = x.Value * 1
'MsgBox x.Address
End If
End If
Next x
End Sub

kodları uygulayınca işlem sonuçlandı. Ancak tek makro ile çözmek daha pratik olacaktı. Ayrıca F1:G500 gibi hücre sınırlama yerine son dolu satır özelliği daha pratik olurdu. Teşekkürler.