• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excel'de 2 ayrı tabloda ortak olan değerlerin silinmesi

Tabloda soldaki tablodaki bir değer sağdaki değerlerden birkaçı ile sağlanabilmektedir, bunu sağlarken tarihlerin de aynı olması gerekiyor.

Son olarak, tablodaki yanlış değerlerin silinmesi ihtimaline karşı, tablodaki makroyu bunu sağlayabilen şekilde düzenleyebilir miyiz.
 
veyselemre,

Sn. Veyselemre;

Göndermiş olduğunuz tablo çok beğenildi fakat yeterince güvenilir bulunmadı. Bizim tablolara birbirini sağlayan parasal değerlerin tarihleri de eşitti.

Sizden istediğim, mevcut makroya, bu şekilde parasal değerleri sağlayan değerlerin tarihleri de eşitse silinmesi koşulunu sağlayabilir misiniz. Ben üzerinde uğraştım fakat şu ana kadar bi sonuç elde edemedim.

Yardımcı olabilirseniz sevinirim.

Saygılar...
 
Sayın kasif2, birşey aklıma takıldı C5 44.415,52 değeri ile
I6 Ve I7 lerin toplamı 44.414,55 var siz ikisini aynı renk ile işaretlemişsiniz herhalde bunların ikisininde silinmesini istiyorsunuz.
Acaba bu küsüratla gözdenmi kaçtı yoksa 44.41#.## gibi değerler aynı olarakmı kabul edilecek
 
Sn. fructose, haklısınız, bu gözümden kaçmış, C5'in doğru değeri 44.414,52 olacaktı. Yani birebir sağlaması gerekiyor.
 
Ekteki dosyada soldaki tablodaki değer sağdaki tabloda varsa (veya birkaç değerin toplamı bunu sağlıyorsa) mevcut makroyla bu değerler karşılıklı siliniyor. Fakat ayrıca bu sağlayan değerlerin tarihlerinin de tutması gerekiyor.

Bu şekilde soldaki tablodaki 165,55 ve 20,00 değerlerinin silinmemesi gerekir, ama mevcut makroyla bunlar da siliniyor.

Acaba makroya, silerken tarih koşulunu da sağlamasını ekleyebilir miyiz.
 
Aşağıdaki 1e1 Sil komutu işe yarıyor ama 1e2 Sil komutu çalışmıyor...

Sub sil_1e1()
For x = 3 To [C65536].End(3).Row
For y = 3 To [I65536].End(3).Row
If Cells(x, 3) = Cells(y, 9) And Cells(x, 3).Offset(0, 1) = Cells(y, 9).Offset(0, 1) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e1
End If
Next y, x
End Sub
-----------------------------------------------------------------------------------
Sub sil_1e2()
For x = 3 To [C65536].End(3).Row
For y = 3 To [I65536].End(3).Row - 1
For z = y + 1 To [I65536].End(3).Row
Union(Cells(x, 3), Cells(y, 9), Cells(z, 9)).Select
If Cells(x, 3) = Round(Cells(y, 9) + Cells(z, 9), 2) And Cells(x, 3).Offset(0, 1) = Cells(y, 9).Offset(0, 1) = Cells(z, 9).Offset(0, 1) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e2
End If
Next z, y, x
End Sub
 
İkili kod aşağıdaki gibi. Ama ne yaptıysak bunu 3'lüye uyarlıyamadık.

Sub Yeni_bire_iki()
x = 3
y = 3
tekrar:
bulunacak = Cells(x, y)
tarih2 = Cells(x, y).Offset(0, 1)
If bulunacak = "" Then GoTo bitir
For i = 3 To WorksheetFunction.CountA(Range("I:I"))
Range("I" & i).Select
For k = 3 To WorksheetFunction.CountA(Range("I:I")) + 1
ikilitoplam = ActiveCell.Value + Range("I" & k).Value
tarih1 = ActiveCell.Offset(0, 1)
tarih3 = Range("I" & k).Offset(0, 1)
If bulunacak = ikilitoplam And tarih2 = tarih3 And tarih1 = tarih2 Then
satir1 = x
satir2 = ActiveCell.Row
satir3 = Range("I" & k).Row
If satir2 = satir3 Then GoTo ileri
Range("A" & satir1 & ":" & "E" & satir1).Delete shift:=xlUp
Range("G" & satir3 & ":" & "K" & satir3).Delete shift:=xlUp
Range("G" & satir2 & ":" & "K" & satir2).Delete shift:=xlUp
ileri:
GoTo baska_ara
End If

Next k
Next i
baska_ara:
x = x + 1
GoTo tekrar
bitir:

End Sub
 
dosyanın son hali budur, yavaş da olsa bu şekilde kullanabiliyorum
 

Ekli dosyalar

Son düzenleme:
Geri
Üst