duplication önleme

[caylakmuhendis]

Merhabalar,

Excel 2010da çalışıyorum. İki farklı excel dosyam var. a.xlsm excelindeki veriyi bir buton sayesinde b.xslm ' e gönderiyorum. Sorun şu ki,

a.xlsm içine veri girildikten sonra buton ile b.xlsm e iletiliyor fakat a.xlsm içinde hiç bir değişiklik yapmadan tekrar butona tıkladığımda aynı içeriği tekrar b.xlsm e yazıyor.

Ben istiyorum ki b. xlsm de mevcut olan değerler tekrar yazdırılmasın.

Amacım aynı verinin defalarca girilip yer işgal etmemesi.

Bunu excel özelliği ya da makro veya herhangi bir yolla nasıl çözerim?

Teşekkürler,
İyi Çalışmalar

 

[YUSUF44]

Bunun için örnek dosya paylaşırsanız iyi olur.

 

[caylakmuhendis]

Sub Sent() [COLOR="Red"]' User interface içeriğini b workbookuna atayan makro[/COLOR]

Set Sheet1 = Workbooks("a.xlsm").Sheets("Sayfa1") 

Workbooks.Open Filename:="\\...\b.xlsm" [COLOR="red"]' path of b workbook[/COLOR]

SON = Sheet1.Cells(Rows.Count, "C").End(3).Row [COLOR="red"]' Sheet1'deki tabloya ait C sütununda veri girişi yapılan son satır[/COLOR]

[COLOR="red"]' a.xlsmdeki tabloda C sütununu baz alarak satır sayısı belirleyip b workbookuna ait tabloya aktaran kısım[/COLOR]
For i = 1 To SON
If Sheet1.Cells(i, "C") <> "" Then
yeni = Workbooks("b.xlsm").Sheets("Sayfa1").Cells(Range("Tablo13").Rows.Count, "C").End(3).Row + 1

Sheet1.Rows(i).Copy
Workbooks("b.xlsm").Sheets("Sayfa1").Cells(yeni, "A").Select

[COLOR="red"]' kopyalanan kısımdaki hücreler b workbookuna yalnızca değer olarak aktarılır, hücre stilleri vs. dahil değil[/COLOR]
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
End If
Next

[COLOR="red"]'işlem sonunda kaydın tamamlandığını belirten mesaj kutusu, ardından b.xlsm e ait son durumun kaydedilmesi ile ilgili onay[/COLOR]

Application.ScreenUpdating = True
MsgBox "KAYIT İŞLEMİ TAMAMLANMIŞTIR.", vbInformation
ActiveWorkbook.Close
[Sheet1].Select

End Sub

Kod bu şekilde.

a.xlsm içinde A-J sütunları arasında 6. satırdan başlayan bir tablom var. Bu tabloya girilen içerikler b.xlsm içine değer olarak atanıyor ve burda tablo olarak tutuluyor.

 

[YUSUF44]

yeni =

satırından sonra:

if worksheetfunction.countif(Workbooks("b.xlsm").Sheets("Sayfa1").range("A1:A" & yeni), Sheet1.Cells(i, "A"))>0 then goto 10

satırını ve Next satırından önce de

10:

satırını ekleyip deneyin.

Bu kodlar b.xlsm'de A sütununda, a.xlsm'de ilgili satırın A hücresi varsa sonraki satıra geçmeyi sağlar.

 

[caylakmuhendis]

Çok çok teşekkür ederim, kodu denedim, bahsettiğiniz amaca hizmet ediyor.

Peki acaba bu durumu yalnız A sütunu ile sınırlamadan, A B C D ... J sütunlarının (tüm sütunların) tümü için yapabilmemiz mümkün müdür?

Yani tüm sütundaki değerler aynıysa yazdırmasın, bir sonraki satıra geçsin.

Bununla ilgili nasıl bir düzenleme yapılabilir?

 

[YUSUF44]

Onu da CountIfs formülüyle yapabiliriz:

if worksheetfunction.countif[B][COLOR="Red"]s[/COLOR][/B](Workbooks("b.xlsm").Sheets("Sayfa1").range("A1:A" & yeni), Sheet1.Cells(i, "A"), Workbooks("b.xlsm").Sheets("Sayfa1").range("B1:B" & yeni), Sheet1.Cells(i, "B"), ..... )>0 then goto 10

Noktalı yerlere aynı düzende tüm sütunları yazmanız gerekir. Kısa olması için b.xlsm'nin ilgili sayfası için yapılan Sheet tanımlaması gibi bir tanımlama yaparsanız iyi olur.

 

[caylakmuhendis]

Yusuf Bey merhabalar, öncelikle ilgilendiğiniz için tekrar tekrar teşekkür ederim fakat kod sütunların yalnızca doluluğunu kontrol ediyor olabilir mi?

Son haliyle tüm sütunları ekledim. Sonra a.xlsm için tüm sütunları doldurarak bir veri girip butona bastım, b.xlsm e kaydedildi.Fakat hiç bir değişiklik yapmadan tekrar butona bastığımda aynı veri b. xlsm e tekrar kaydedildi.

Yani amacım duplicationları engellemekti ama makro bu amaca hizmet etmedi sanıyorum ??

Önerebileceğiniz bir çıkış yolu var mıdır?

 

[YUSUF44]

Kaydetmemesi gerekir. Örnek dosyaları eklerseniz deneyerek çözüm bulabiliriz.

 

[caylakmuhendis]

sanıyorum bu link ile dosyalara erişebileceksiniz ;

http://s6.dosya.tc/server7/wy7n7k/Task.rar.html

 

[YUSUF44]

Yaptığım denemelerde sadece benzersiz satırları aktardı. Mükerrerliğe izin vermedi. Bir şeyleri yanlış yapıyorsunuz demek ki.

Kodun düzgün görünmesi için uzun satırı birkaç satıra böldüm, bir de b.xlsm'yi kaydedip kapatma komutu ekledim. Aktarma kodları aynen duruyor:

Sub Sent()

Set Sheet1 = Workbooks("a.xlsm").Sheets("Sayfa1")

Workbooks.Open Filename:=ThisWorkbook.Path & "\b.xlsm"

SON = Sheet1.Cells(Rows.Count, "C").End(3).Row
For i = 1 To SON
If Sheet1.Cells(i, "C") <> "" Then
yeni = Workbooks("b.xlsm").Sheets("Sayfa1").Cells(Range("Tablo13").Rows.Count, "C").End(3).Row + 1
If WorksheetFunction.CountIfs(Workbooks("b.xlsm").Sheets("Sayfa1").Range("A1:A" & yeni), Sheet1.Cells(i, "A"), _
Workbooks("b.xlsm").Sheets("Sayfa1").Range("B1:B" & yeni), Sheet1.Cells(i, "B"), _
Workbooks("b.xlsm").Sheets("Sayfa1").Range("C1:C" & yeni), Sheet1.Cells(i, "C"), _
Workbooks("b.xlsm").Sheets("Sayfa1").Range("D1:D" & yeni), Sheet1.Cells(i, "D"), _
Workbooks("b.xlsm").Sheets("Sayfa1").Range("E1:E" & yeni), Sheet1.Cells(i, "E"), _
Workbooks("b.xlsm").Sheets("Sayfa1").Range("F1:F" & yeni), Sheet1.Cells(i, "F"), _
Workbooks("b.xlsm").Sheets("Sayfa1").Range("G1:G" & yeni), Sheet1.Cells(i, "G"), _
Workbooks("b.xlsm").Sheets("Sayfa1").Range("H1:H" & yeni), Sheet1.Cells(i, "H"), _
Workbooks("b.xlsm").Sheets("Sayfa1").Range("I1:I" & yeni), Sheet1.Cells(i, "I"), _
Workbooks("b.xlsm").Sheets("Sayfa1").Range("J1:J" & yeni), Sheet1.Cells(i, "J")) > 0 Then GoTo 10

Sheet1.Rows(i).Copy

Workbooks("b.xlsm").Sheets("Sayfa1").Cells(yeni, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
End If

10:

Next

Application.ScreenUpdating = True
MsgBox "KAYIT ISLEMI TAMAMLANMISTIR.", vbInformation
ActiveWorkbook.Save
ActiveWorkbook.Close
Sheet1.Select

End Sub

 

[caylakmuhendis]

Yusuf Bey siz şimdi a. xlsm bir satır veri girişi yapıp sent butonu ile b ye gönderdikten sonra hiçbir değişiklik yapmadan send butonuna tekrar tıkladığınızda aynı veriyi b ye ikinci kez yazmıyor mu?

Ben kodu aynen copy paste yapıp denedim fakat aynı veri b ye ikinci kez yazdırılıyor maalesef.

ilk send işlemi ile gönderiyor kayıt işlemi başarılı diyor tamam dedikten sonra aynı a ekranı karışma geliyor, orda tekrar send dediğimde b ye aynı veriyi ikinci satır olarak tekrar ekliyor.

excel 2010 kullanıyorum, bu işlemi sizde sorunsuz gerçekleştirip bende sorun çıkarmasının versiyon farkıyla bir alakası olabilir mi acaba ?

 

[YUSUF44]

Nedenini bilmiyorum. Yaptığım her denemede sadece benzersiz kayıtları aktardı. Ekteki dosyada göreceğiniz üzere a'da aynı satırdan birden fazla olduğu durumlarda da denedim, üst üste birden fazla kez Send'e de bastım, her durumda benzersizler aktarıldı:

Task.zip

 

[caylakmuhendis]

sanıyorum excel ile ilgili teknik bir hata. gönderdiğiniz dosyadaki butonu kullandığım zaman library hatası alıyorum

İlgilendiğiniz için tekrar tekrar teşekkür ederim Yusuf Bey, minnettarım.

İyi çalışmalar

 

[YUSUF44]

Eğer dosyaları zip'ten çıkarıp aynı klasör içine almadan doğrudan zip dosyasının içinden çalıştırırsanız makro dosyayı bulamaz. Çünkü açılan dosyalar aynı klasörde olmaz.

Hata oluşmaması için dosyayı zipten çıkardıktan ve aynı klasörde olduğuna emin olduktan sonra kullanın.