- Katılım
- 24 Kasım 2007
- Mesajlar
- 769
- Excel Vers. ve Dili
- Office 365 - Türkçe
- Altın Üyelik Bitiş Tarihi
- 30-01-2024
Merhaba ekteki dosyamda 5. ve 6. sütundaki hücrelerin içeriğini 4. satırdan itibaren aşağıya doğru (4200 satır) tarıyor, aynı değerleri sahip satırları temizliyor. 4200 satır verim var, fakat neredeyse 10 dakika sürüyor. Çünkü sürekli döngü halinde. Bunun daha kolay bir hali varmıdır. Kodlarım ve dosyam ektedir
Kod:
Sub Durusfilitre_Satirlari_Temizle()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim m, i As Long
sonsatir = Sheets("Durusfilitre").Cells(Rows.Count, "C").End(3).Row
For m = 4 To sonsatir
If Sheets("Durusfilitre").Cells(m, 5) <> "" Then
For i = m + 1 To sonsatir
If Sheets("Durusfilitre").Cells(m, 5) = Sheets("Durusfilitre").Cells(i, 5) And Sheets("Durusfilitre").Cells(m, 6) = Sheets("Durusfilitre").Cells(i, 6) Then
'Sheets("Durusfilitre").Rows(i).ClearContents
'Sheets("Durusfilitre").Range("B & i:I" & i).ClearContents
Sheets("Durusfilitre").Cells(m, 2).ClearContents
Sheets("Durusfilitre").Cells(m, 3).ClearContents
Sheets("Durusfilitre").Cells(m, 4).ClearContents
Sheets("Durusfilitre").Cells(m, 5).ClearContents
Sheets("Durusfilitre").Cells(m, 6).ClearContents
Sheets("Durusfilitre").Cells(m, 7).ClearContents
Sheets("Durusfilitre").Cells(m, 8).ClearContents
Sheets("Durusfilitre").Cells(m, 9).ClearContents
End If
Next i
End If
Next m
Application.ScreenUpdating = True
End Sub
Ekli dosyalar
-
378 KB Görüntüleme: 5