Hatalı Kayıtları Ayıklamak istiyorum.

Katılım
10 Ocak 2007
Mesajlar
11
Excel Vers. ve Dili
Office XP türkçe
70000'i aşkın datanın bulunduğu DBF formatındaki dosyamda silinen kayıtlar yeniden ortaya çıktı. Bunları tek tek silmem mümkün değil fakat ekteki dosyada ayrıntısıyla açıkladığım şekilde bu kayıtları tespit edebilmem için, bir formül veya komut lazım. Bilen biri ilgilenip bana yardım ederse, Devletimize yaklaşık 1.5 yıllık bir hizmet etmiş olur. Çünkü bu dataları iki kişi 1.5 yılda girebildik. Ekte sunduğum dosyada sadece örnek vardır. Kayıtların tamamı 70.000'in üzerindedir. Ayrıntılı açıklama ekteki dosyadaki word dosyasının içindedir. İlginize şimdiden teşekkür ederim. Dosya DBF formatında olup excel ile açılabilmektedir.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,680
Excel Vers. ve Dili
Excel 2019 Türkçe
Umarım doğru anlamışımdır. Ekte iki makro var biri hatalıları diğeri de düzgün olanları listeliyor.
 
Katılım
10 Ocak 2007
Mesajlar
11
Excel Vers. ve Dili
Office XP türkçe
Doğru yoldasınız. Ama eksiklikler var.

Kısmen doğru fakat ana tabloda 19 kayıt varken neden diğer tablolardaki kalıtlarının sayısı 16 oluyor, yani veri kaybına neden oluyor. Mesela 1 nolu sahifedeki kayıt düzgün, fakat makro çalışınca 1 nolu sahifedeki 3/6, 1/6 ve 1/6 kaydı alıyor hatalılar listesine ekliyor, geri kalan 1/6 hisse kayıp oluyor. Ama sanırım konuyu doğru kavramışsınız. Veri kaybınıda çözebilirseniz benim işimi büyük ölçüde çözmüş olacaksınız.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,680
Excel Vers. ve Dili
Excel 2019 Türkçe
Farklı bir çözüm yapmayı düşündüm.

PDURUM sütununda "T" olarak görünenler düzgün kayıtlar olarak mı kabul edilecek ?
 
Katılım
10 Ocak 2007
Mesajlar
11
Excel Vers. ve Dili
Office XP türkçe
T'nin anlamı

Hayır T 'nin anlamı Gayrimenkulün tamamının birkişiye ait olduğunu gösterir. H ise hisseli olduğunu yani birden fazla kişiye ait olduğunu, benim istediğim aynı sayfa numaralı kayıtların hisse toplamlarının tam olması T veya H olması burada tabiki benim açımdan birşey ifade ediyor ama formül için sanırım pek gerekli olmaz. Bu iş daha çok Hisselerin toplamının sadeleştirilmiş halinin 1'e eşit olmasında düğümleniyor sanırım. Çünki Bir bütünün parçalarının toplayınca sonuç 1 olur, ama burada silinen kayıtlarda gözüktüğü için, birden daha büyük çıkması lazım. Tabi bu arada kayıtlardaki eksik bilgi girişi vs hatalardan dolayı 1'e eişt olmayan, 1 den küçük veya büyük olan kayıtlarda olabilir, Ben bunları kontrol edip, hatanın programdanmı, yoksa tapu defterlerinde de yanlışmı yazıldığını kontrol edebilirim, çünki bu kayıtların sayısı 100- 150 civarında sanırsam. Yani defterde de hatalı yazılan kayıtlar var, program bunları bulabiliyor, ama sonradan ortaya çıkan kayıtları bulamıyor ne hikmetse. Halbuki onlarda hisse toplamının yanlış olmasına sebebiyet veriyor. İşte T ve H ler burada programı yanıltıyor. Programda bir sahifeye girilen malik isimlerinden birinin bile karşısında T varsa yani hissesi tam olarak işaretlenmişse diğerleninin vereceği fazlalığı bulamıyor. Daha kısacası hisse toplamları ne olursa olsun, program onu 0/0 veya 1/1 gibi sonucu 1'e eşit olacak şekilde algılıyor. O yüzden de hisselerdeki yanlışlığı bulamıyor.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,680
Excel Vers. ve Dili
Excel 2019 Türkçe
Merhabalar, araya haftasonu girdiği için sorunuza bakamamıştım. Son verdiğiniz bilgilere göre, kodları değiştirdim. Bir de böyle dener misiniz ?

Kod:
Sub HATALI()

Sheets("HATALI").Cells.ClearContents
Sheets("TOBLO1").Select
x = 1
son = [a65536].End(3).Row
Range("a2:" & "aa" & son).Sort key1:=[f2]

For t = 2 To son
If Cells(t, "v") <> 0 And Cells(t, "w") <> 0 Then
x = x + 1
For y = 1 To 27
Cells(t, y).Interior.ColorIndex = 6

Sheets("HATALI").Cells(x, y) = Cells(t, y)
Next
End If

Next
Sheets("HATALI").Rows(1) = Rows(1).Value
End Sub

Sub DUZGUN()
Sheets("DUZGUN").Cells.ClearContents
Sheets("TOBLO1").Select
x = 1
son = [a65536].End(3).Row
Range("a2:" & "aa" & son).Sort key1:=[f2]

For t = 1 To son
If Cells(t, "v") = 0 And Cells(t, "w") = 0 Then

x = x + 1
For y = 1 To 27
Cells(t, y).Interior.ColorIndex = 6
Sheets("DUZGUN").Cells(x, y) = Cells(t, y)
Next
End If

Next
Sheets("DUZGUN").Rows(1) = Rows(1).Value

End Sub
 
Katılım
10 Ocak 2007
Mesajlar
11
Excel Vers. ve Dili
Office XP türkçe
Ekteki örnekle konuyu daha iyi açıkladığımı düşünüyorum.

Merhaba Konunun yeterince anlaşılamadığını düşünerek, ekte yeni bir dosya hazırladım. Hatalı olması gereken kayıtlar ile düzgün olması gereken kayıtları ve bunların hangi mantıkla bu şekilde tasnif edilmeleri gerektiğini açıkladım. Birde böyle deneyelim isterseniz.

Yani Olay tamamen kesir hesabında bitiyor.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,680
Excel Vers. ve Dili
Excel 2019 Türkçe
Sayın Sinova57, eki inceleyin.
 
Katılım
10 Ocak 2007
Mesajlar
11
Excel Vers. ve Dili
Office XP türkçe
Selam Hamitcan kardeş, ben kafayı sıyırdım zaten de sende sayemde sıyırmazsın inşallah. Çünkü bu seferde olmuyor. ben durumun vehametinin daha iyi anlaşılması için tablolardan birinin tamamını yolluyorum. Yazı karakterleri kırmızı ile boyalı olanlar hatalı olanlar. Tabi bunların dışında da hatalı kayıt varmı bilemiyorum. Çok detaylı incelemeden hepsini bulmak mümkün değil zaten. Bu tablo gibi 51 tane tablo var elimde ve hepsi bukadar basit de değil, hisseleri daha karışık olanlar var. Ama şekil aynı. Birini çözsek diğerlerini de çözerizde.

Birde bu tabloda çalışmayı dene istersen. Sana da zahmet veriyoruz ama. Sonuçta bu kayıtları bir şekilde düzeltemezsek 1,5 yıllık emeğimiz boşa gidecek.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,680
Excel Vers. ve Dili
Excel 2019 Türkçe
Sayın Sinova57, pay ve paydaları bulmak oldukça zor oldu. Umarım bir yerde eksiklik yoktur. Hatalıları aynı sayfada buldurdum. Bu şekilde de işinizi görür sanırım. Süzü kullanarak hatalı olanları süzdürebilirsiniz.

İyi çalışmalar...
 
Katılım
10 Ocak 2007
Mesajlar
11
Excel Vers. ve Dili
Office XP türkçe
Olayın mantığını kavramışsın, Mantık doğru ve bu şekilde büyük oranda işimi çözüyor, en azından sadece bu köy için düşünürsek, toplam 3698 kayıttan, incelenecek kayıt sayısı 875 kayda düşüyor. Fakat paydaları eşit olmayanlarda sorun var sanırım. Hatalılarla birlikte gösteriyor onlarıda, mesela 55 sahife nolu kayıtta hisse toplamları aslında doğru, paydası 1080 olan payların toplamı 807 ve paydası 5400 olan payların toplamı 1365 oluyor, paydaları eşitlediğimizde 1080 x 5 = 5400 'de eşitleniyor, o zaman 807/1080 * 5 = 4035/5400 oluyor, 4035/5400 + 1635/5400 = 5400/5400 yani oda eşittir 1 oluyor, sonuç doğru. Ama seni çok uğraştıracaksa, bilmiyorum belki kayıtları hatalı diye ayırdıktan sonra ikinci bir işleme tabi tutarak, paydalar eşitlenip, yeniden bir ayıklama yapılabilirse bu sorunda ortadan kalkacak sanırım.
Emeğin için çok teşekkür ederim.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,680
Excel Vers. ve Dili
Excel 2019 Türkçe
Sayın Sinova57, kodu değiştirdim. Hatalıların sayısı azaldı ama kontrol etmedim. İnceleyin eksiklik varsa devam ederiz.
Kod:
Sub HATALI2()
Sheets("TOBLO3").Select
son = [a65536].End(3).Row
Range("a2:" & "aa" & son).Sort key1:=[f2]
'pay ve paydaları bul--------------------------------------------
For t = 2 To son
    payda = Cells(t, "ac")
    say = WorksheetFunction.CountIf(Range("f" & t & ":" & "f" & son), Cells(t, "f"))
    If Cells(t, "f") = Cells(t + 1, "f") And Cells(t, "z") = "T" Then
    Range("ab" & t & ":ac" & t) = Cells(t + 1, "w").Value
    ElseIf Cells(t, "f") = Cells(t - 1, "f") And Cells(t, "z") = "T" Then
    Range("ab" & t & ":ac" & t) = Cells(t - 1, "w").Value
    Else
    Range("ab" & t & ":ac" & t) = Range("v" & t & ":w" & t).Value
    End If
Next
'hatalıları bul--------------------------------------------
For tt = 2 To son
    say2 = WorksheetFunction.CountIf(Range("f" & tt & ":" & "f" & son), Cells(tt, "f"))
    If say2 = 1 Then
    olcut = Cells(tt, "f")
    pay = 0
    pay = WorksheetFunction.SumIf(Range("f2:" & "f" & son), olcut, Range("ab2:" & "ab" & son))
    
    payda = Cells(tt, "ac")
    If pay <> payda Then
    bas = WorksheetFunction.Match(olcut, Range("f2:" & "f" & son), 0)
    For j = tt - bas To 1 Step -1
        Cells(tt - j + 1, "ad") = "hatalı"
        buyuk = WorksheetFunction.Max(Range("ac" & bas + 1 & ":ac" & tt), 1)
        kucuk = WorksheetFunction.Small(Range("ac" & bas + 1 & ":ac" & tt), 1)
        If buyuk <> kucuk Then
        pay2 = WorksheetFunction.SumIf(Range("ac" & bas + 1 & ":ac" & tt), kucuk, Range("ab" & bas + 1 & ":ab" & tt))
        pay3 = WorksheetFunction.SumIf(Range("ac" & bas + 1 & ":ac" & tt), buyuk, Range("ab" & bas + 1 & ":ab" & tt))
        If pay2 * (buyuk / kucuk) + pay3 = buyuk Then Cells(tt - j + 1, "ad") = ""
        End If
    Next j
    End If
    End If
Next tt
End Sub
 
Katılım
10 Ocak 2007
Mesajlar
11
Excel Vers. ve Dili
Office XP türkçe
Teşekkür ederim arkadaş, Benim size aktardığım sorun kadarını bu komutlar çözdü. Şimdi artık iş hatalı kayıtları ayıklamaya geldi. Bakalım sonuç ne olacak.
 
Üst