Belirli Şartta Tekrar Edenleri Silme

[babolii]

Merhaba arkadaşlar. Ekte gördüğünüz gibi bir örnek koydum. Sayfa1 dediğim ham veri. Ben sizin verdiğiniz makroyu çalıştırdığımda Sonuc sayfasındaki gibi olacak. Yani D ve E sütununda kendini tekrar edenlerin F sütunundaki karşılığını teke düşürecekler. Pozitif olan kalacak. Zaten dosyaya bakar bakmaz anlayacaksınız.
Teşekkür ederim.

 

[babolii]

https://s2.dosya.tc/server30/dtw386/Kitap3.xlsx.html

arkadaşlar dosya bu. demin yukarıya yanlış dosyayı koydum lütfen buna bunu indirin

 

[babolii]

arkadaşlar bunu nasıl çözeriz

 

[ccuneyt13]

Merhaba,

Aşağıdaki kodları denermisiniz.
Çok hakim değilim ama örnek dosyanızda sorunsuz çalışıyor.

Sub ozet()
Application.ScreenUpdating = False

Dim S1, S2, Son, Son2, i
Dim SonHucre As String
Set S1 = ThisWorkbook.Sheets("Sayfa1")
Set S2 = ThisWorkbook.Sheets("Sonuc")

Son = Sheets("Sayfa1").Cells(Rows.Count, 1).End(xlUp).Row
Son2 = Sheets("Sonuc").Cells(Rows.Count, 1).End(xlUp).Row
SonHucre = S1.Cells.SpecialCells(xlCellTypeLastCell).Address
S1.Select
S1.Range("J1").Value = "Birleşen"

For i = 2 To Son
S1.Cells(i, 10).Value = Cells(i, 4) & " - " & S1.Cells(i, 5) & " - " & S1.Cells(i, 8)
Next i
'i = ""
S2.Select
S2.Cells.Clear
S1.Select
S1.Range("A1").Select
S1.Range("A1" & ":J" & Son).Select
Selection.Copy
S2.Select
S2.Range("a1").PasteSpecial xlPasteValues
S2.Columns("J").AutoFit
S2.Columns("C").AutoFit

If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData

ActiveSheet.Range("$A$1:" & SonHucre).AutoFilter Field:=7, Criteria1:="<0", _
        Operator:=xlAnd
        
    Range("c2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.ShowAllData


S2.Range("A1:J" & Son).RemoveDuplicates Columns:=10, Header:=xlYes
S2.Range("A1").Select
Application.ScreenUpdating = True

MsgBox " İşlem Tamamlandı"
End Sub

 

[babolii]

Merhaba,

Aşağıdaki kodları denermisiniz.
Çok hakim değilim ama örnek dosyanızda sorunsuz çalışıyor.

Sub ozet()
Application.ScreenUpdating = False

Dim S1, S2, Son, Son2, i
Dim SonHucre As String
Set S1 = ThisWorkbook.Sheets("Sayfa1")
Set S2 = ThisWorkbook.Sheets("Sonuc")

Son = Sheets("Sayfa1").Cells(Rows.Count, 1).End(xlUp).Row
Son2 = Sheets("Sonuc").Cells(Rows.Count, 1).End(xlUp).Row
SonHucre = S1.Cells.SpecialCells(xlCellTypeLastCell).Address
S1.Select
S1.Range("J1").Value = "Birleşen"

For i = 2 To Son
S1.Cells(i, 10).Value = Cells(i, 4) & " - " & S1.Cells(i, 5) & " - " & S1.Cells(i, 8)
Next i
'i = ""
S2.Select
S2.Cells.Clear
S1.Select
S1.Range("A1").Select
S1.Range("A1" & ":J" & Son).Select
Selection.Copy
S2.Select
S2.Range("a1").PasteSpecial xlPasteValues
S2.Columns("J").AutoFit
S2.Columns("C").AutoFit

If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData

ActiveSheet.Range("$A$1:" & SonHucre).AutoFilter Field:=7, Criteria1:="<0", _
        Operator:=xlAnd
       
    Range("c2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.ShowAllData


S2.Range("A1:J" & Son).RemoveDuplicates Columns:=10, Header:=xlYes
S2.Range("A1").Select
Application.ScreenUpdating = True

MsgBox " İşlem Tamamlandı"
End Sub

olmadı hocam. Yaptığımız işlem şu aslında. Muhasebe işi yapıyoruz ve ters kayıtların silinmesini istiyoruz. Yani tek satır kalacak.

 

[ccuneyt13]

Olmayan tam olarak nedir. Linkte bendeki sonucu iletiyorum.
İstediğiniz 2 satır kalıyor kod sonucunda.

Kitap3__3_.xlsm dosyasını indir - download

Kitap3__3_.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

Herhangi bir değişiklik yapmadan kodu tekrar çalıştırıp olmayan tarafı iletirmisiniz.

 

[babolii]

Olmayan tam olarak nedir. Linkte bendeki sonucu iletiyorum.
İstediğiniz 2 satır kalıyor kod sonucunda.

Kitap3__3_.xlsm dosyasını indir - download

Kitap3__3_.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

Herhangi bir değişiklik yapmadan kodu tekrar çalıştırıp olmayan tarafı iletirmisiniz.

hocam verdiğiniz kodu tekrar denedim çalıştı ancak söylemeyi unutmuşum bir koşul eksik. örneğin aynı fatura numarasından ve aynı vergi türünden iki satır var ve kdv tutarları farklı biri (+) bakiye biri (-) 'dir. böyle bir durumda iki satırında silinmesini istiyorum. örnek olarak ekran görüntüsünü paylaşıyorum.



Örneğin buradaki bu şartlardaki bütün satırların silinmesini istiyorum

yardımınızı bekliyorum çok teşekkür ederim