bayinin eksik özelliklerini arayıp gösterme

[quesh]

Merhaba arkadaşlar.

Ekteki excel dosyasında BAYİLER adlı sayfada bayi adı,kodu,tel ve faks no.ları bulunmakta. ancak bazı bayilerin ya tel. ya faks yada her iki numarası eksik durumda. benim yapmak istediğim ''BAYİLER'' sayfasında hangi bayilerin tel. no eksikse bu bayilerin isim,bayi kodu ve bayi sorumlusunu ''EKSİKLER(TELEFON)'' sayfasına alt alta kopyalaması,,, ve yine aynı şekilde ''BAYİLER'' sayfasında hangi bayilerin faks. no eksikse bu bayilerin isim,bayi kodu ve bayi sorumlusunu ''EKSİKLER(FAKS)'' sayfasına alt alta kopyalaması.

Yardımcı olan,olmaya çalışan herkese teşekkür ederim

 

[leumruk]

Merhaba,
Aşağıdaki kodu bir butona bağlayarak çalıştırın.

Sub Eksik_Bul()
Set s1 = Sheets("EKSİKLER(TELEFON)")
Set s2 = Sheets("EKSİKLER(FAKS)")
If WorksheetFunction.CountIf(Range("d2:e" & [a65536].End(3).Row), "") > 0 Then
Set Aralik = Range("d2:e" & [a65536].End(3).Row).SpecialCells(xlCellTypeBlanks)
For Each hcr In Aralik
If hcr.Column = 4 Then
Sat = s1.[a65536].End(3).Row + 1
Range("a" & hcr.Row & ":c" & hcr.Row).Copy s1.Cells(Sat, "a")
ElseIf hcr.Column = 5 Then
Sat = s2.[a65536].End(3).Row + 1
Range("a" & hcr.Row & ":c" & hcr.Row).Copy s2.Cells(Sat, "a")
End If
Next
MsgBox "Aktarım tamamlanmıştır.", vbInformation, "DURUM"
Else:
MsgBox "Aktarılacak veri bulunamadı.", vbCritical, "UYARI"
End If
End Sub

 

[quesh]

çok teşekkürler

yalnız butona bağlayıp çalıştırmayı bilmediğim/anlamadığım için yapamadım.
ancak yine de çalıştı ve ''aktarım tamamlanmıştır'' uyarısını aldım ve doğruladım.

butona bağlayıp çalıştırmamış olmam bir sorun teşkil eder mi ? etmese dahi daha kolay olabilmesi için butona bağlayıp çalıştırmayı nasıl yapabilirim?

teşekkür ederim

 

[leumruk]

çok teşekkürler

yalnız butona bağlayıp çalıştırmayı bilmediğim/anlamadığım için yapamadım.
ancak yine de çalıştı ve ''aktarım tamamlanmıştır'' uyarısını aldım ve doğruladım.

butona bağlayıp çalıştırmamış olmam bir sorun teşkil eder mi ? etmese dahi daha kolay olabilmesi için butona bağlayıp çalıştırmayı nasıl yapabilirim?

teşekkür ederim

Hayır, herhangi bir sorun olmaz. Sanırım office 2007 kullanıyorsunuz. Ben 2003 kullanıyorum. Düğme ekleme menüsünün 2007' de nereden oluşturulduğunu bilemiyorum. Google'den aratarak bulabilirsiniz.

 

[quesh]

Hayır, herhangi bir sorun olmaz. Sanırım office 2007 kullanıyorsunuz. Ben 2003 kullanıyorum. Düğme ekleme menüsünün 2007' de nereden oluşturulduğunu bilemiyorum. Google'den aratarak bulabilirsiniz.

düğmeyi ekledim, kodu da düğmeye ekledim.
ancak düğmeye tıkladığımda hiçbir tepki vermiyor. ta ki ben vba'da run 'ı tıklayana kadar, yani düğmeye bir işlevsellik kazandıramadım,

 

[quesh]

dosya ektedir.
http://ul.to/hkmjyc
saygılarımla

 

[leumruk]

Merhaba,
4 nolu mesajıma örnek bir dosya ekledim. Dosyayı inceleyiniz.

 

[quesh]

Merhaba,
4 nolu mesajıma örnek bir dosya ekledim. Dosyayı inceleyiniz.

tekrar teşekkür ederim ancak şöyle bir sorunla karşılaştım;
butona tıkladığımda ya da kodu çalıştırdığımda ; mükerrer hesap yapıyor kod, yani 2 kez üst üste tıkladığımda butona eksik telefon numaralı bayi isimlerini 2 kere getiriyor alt alta, ilk tıklamadan sonra ikinci tıklamada sadece farklılıkları algılayıp ona göre davranması için izlenecek bir yol var mı ?

saygılarımla

 

[leumruk]

tekrar teşekkür ederim ancak şöyle bir sorunla karşılaştım;
butona tıkladığımda ya da kodu çalıştırdığımda ; mükerrer hesap yapıyor kod, yani 2 kez üst üste tıkladığımda butona eksik telefon numaralı bayi isimlerini 2 kere getiriyor alt alta, ilk tıklamadan sonra ikinci tıklamada sadece farklılıkları algılayıp ona göre davranması için izlenecek bir yol var mı ?
saygılarımla

Basit bir ekleme ile sorunu çözebiliriz. Eklediğim satırı kırmızı ile belirtiyorum. Düğmeye tıkladığınızda eski aktarımları silip baştan aktarıyor.

Private Sub CommandButton1_Click()
Set s1 = Sheets("EKSİKLER(TELEFON)")
Set s2 = Sheets("EKSİKLER(FAKS)")
[COLOR="DarkRed"]s1.Range("a2:c65536").ClearContents
s2.Range("a2:c65536").ClearContents[/COLOR]
If WorksheetFunction.CountIf(Range("d2:e" & [a65536].End(3).Row), "") > 0 Then
Set Aralik = Range("d2:e" & [a65536].End(3).Row).SpecialCells(xlCellTypeBlanks)
For Each hcr In Aralik
If hcr.Column = 4 Then
Sat = s1.[a65536].End(3).Row + 1
Range("a" & hcr.Row & ":c" & hcr.Row).Copy s1.Cells(Sat, "a")
ElseIf hcr.Column = 5 Then
Sat = s2.[a65536].End(3).Row + 1
Range("a" & hcr.Row & ":c" & hcr.Row).Copy s2.Cells(Sat, "a")
End If
Next
MsgBox "Aktarım tamamlanmıştır.", vbInformation, "DURUM"
Else:
MsgBox "Aktarılacak veri bulunamadı.", vbCritical, "UYARI"
End If
End Sub

 

[quesh]

çok çok teşekkür ederim. emeğinize sağlık.
saygılar

 

[leumruk]

çok çok teşekkür ederim. emeğinize sağlık.
saygılar

Rica ederim.