ARADIĞIM DEĞERİ KAÇ DEFA YAZILMIŞ İSE LİSTELENMESİ

[celcukus1]

-a1(1234)(verisi)
-a2(ali Veli)(adı Soyadı)(Verisi)
-a3(35,50tl) (verisi)
-a4(18.05.2020)(verisi)
hücrelerine veri yazıyorum bunu diğer sayfaya işlemi tersine çevir yapıp a1-b1-c1-d1 yapıyor a1 hücresine aynı değeri yazdığımda düşeyara ile alt değerleri giriyorum bu şekilde bir listem var lakin farklı tarihlerde girmiş olduğumdan
a1 hücresine yazmış olduğum zaman bana SÜTUNLAR halinde listelemesini yapamadım bana bu konuda yardımcı olur musunuz.
İndir LİSTELEME xlsx
Dosyayı indir LİSTELEME xlsx
dosya.co

 

[YUSUF44]

Aşağıdaki kodları ÖN KAYIT sayfasının kod bölümüne (Sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Set s1 = Sheets("KAYIT SAYFASI")
eski = WorksheetFunction.Max(4, Cells(Rows.Count, "I").End(3).Row)
son = WorksheetFunction.Max(3, s1.Cells(Rows.Count, "A").End(3).Row)
If Target = "" Then
    Range("I4:N" & eski).ClearContents
ElseIf WorksheetFunction.CountIf(s1.Range("A1:A" & son), Target) = 0 Then
    Range("I4:N" & eski).ClearContents
    MsgBox "Girilen aboneye ait herhangi bir kayıt bulunmamaktadır!", vbInformation
    Exit Sub
Else
    Range("I4:N" & eski).ClearContents
    Set con = VBA.CreateObject("adodb.Connection")
    
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
    
    sorgu = "select [ABONE NO],ADI,SOYADI,[TELEFON NOSU],ADRESİ,TARİH " & _
      "from[KAYIT SAYFASI$] where [ABONE NO] = " & Target
      
    Set rs = con.Execute(sorgu)
    [I4].CopyFromRecordset rs
End If

End Sub

 

[celcukus1]

If Intersect(Target, [B1]) Is Nothing Then
BURA DAHATA VERDİ

 

[YUSUF44]

Birden fazla hücre mi seçmiştiniz? Örnek dosyanızda gayet güzel çalışıyor.

 

[celcukus1]

İndir LİSTELEME

Dosyayı indir LİSTELEME

dosya.co

DOSYA BELKİ MAKRO OLARAK KAYDETMEDİM DİYE OLA BİLİR DİYE MAKRO KAYDET TİM OLMADI

 

[celcukus1]

BANA MÜSAİT İSENİZ YOLLAYA BİLİR MİSİNİZ?

 

[YUSUF44]

Benim verdiğim kodlarda Option Explicit satırı yoktu, siz eklemişsiniz. Onu silerseniz çalışır.

 

[celcukus1]

UFUK BEY ÖNCELİK İLE YARDIMLARINIZ İÇİN TEŞEKKÜR EDERİM BE İZMİR DEN TÜRK TELEKOM BAYİSİYİM SİZE BURADAN YARDIMCI OLA BİLECEĞİM BİR ŞEY VAR İSE SEVİNİRİM.

 

[YUSUF44]

Teşekkürler, iyi çalışmalar, sağlıklı günler.

 

[celcukus1]

YUSUF BEY İYİ AKŞAMLAR YOLLAMIŞ OLDUĞUNUZ ŞEYİ YAPMAK İSTEDİĞİM ŞEYE UYARLAMA ÇALIŞTIM LAKİN YAPAMADIM
1-) MÜŞTERİ KAYDEDECEK (YANDA DAHA ÖNCEKİ KAYITLARINI GÖRMEK İSTİYORUM
2-) KAĞIT İSRAFI OLMASIN DİYEDE MÜŞTERİ MAİL ADRESİNE KAYDETTİKTEN (REFERANS NOSU KRİTER ALARAK SONRA MAİL ATMASINI İSTİYORUM
BUNU EXCELDE VBA DA YAPMAYA ÇALIŞTIM BURADA TIKANDIM.

İndir TAHSİLAT0101VRSY

Dosyayı indir TAHSİLAT0101VRSY

dosya.co

 

[YUSUF44]

Sorgudaki sütun başlıklarıyla dosyanızdaki başlıklar birbiriyle uyumlu olmadığı için hata veriyor. Sorgu satırını aşağıdakiyle değiştirin:

    sorgu = "select [ABONE NO],[PERSONEL],[REFERANS NO],[KURUM],[SÖZLEŞME NO],[ABONE İSİM SOYİSİM],[SON ÖDEME TARİHİ]," & _
            "[FATURA TUTARI],[HİZMET BEDELİ],[TOPLAM],[DÜZENLENME TARİHİ],[DEKONT NO],[MÜŞTERİ İRTİBAT NO],[E POSTA ADRESİ],[İL],[İLÇE]," & _
            "[MAHALLE],[SOK],[BİNA NO],[DAİRE NO],[NEREDEN YATTI],[YATIRILAN TARİH],[EKSTRA-1],[EKSTRA-2] " & _
            "from[ANAKAYIT$] where [ABONE NO] =" & Target

Müşteri kaydetme ve e postayla ilgili taleplerinizi anlamadım maalesef. E postayı anlasam da yapamazdım zaten

 

[Korhan Ayhan]

Klavyenizde caps lock tuşu açık kalmış sanırım.

 

[celcukus1]

bilgisayarıma yazdığım listeleri veya bilgileri büyük yazmamızı istiyordu o yüzden el alışkanlığı olmuş özür dilerim saygısızlık yapmak istemedim.

 

[YUSUF44]

Yalnız dosyanızda iki tane abone no sütunu var. Eğer bunlar aynı kodlarsa yukardaki şekilde kullanın, eğer farklı ise birinin başlığını değiştirin ve sorguya o başlığı ilave edin.

 

[celcukus1]

Yalnız dosyanızda iki tane abone no sütunu var. Eğer bunlar aynı kodlarsa yukardaki şekilde kullanın, eğer farklı ise birinin başlığını değiştirin ve sorguya o başlığı ilave edin.

Yusuf Bey İyi Akşamlar kodları yazdım ama if ve else komutunu kafam basmadı ve anlamadım ,


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Set s1 = Sheets("ANAKAYIT")
eski = WorksheetFunction.Max(4, Cells(Rows.Count, "F").End(3).Row)
SON = WorksheetFunction.Max(3, s1.Cells(Rows.Count, "A").End(3).Row)
If Target = "" Then
Range("F2:AE" & eski).ClearContents
ElseIf WorksheetFunction.CountIf(s1.Range("A1:A" & SON), Target) = 0 Then
Range("F2:AE" & eski).ClearContents
MsgBox "Girilen aboneye ait herhangi bir kayıt bulunmamaktadır!", vbInformation
Exit Sub
Else
Range("F2:AE" & eski).ClearContents
Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
sorgu = "select [ABONE NO],[PERSONEL],[REFERANS NO],[KURUM],[TESİSAT NO],[SÖZLEŞME NO],[ABONE İSİM SOYİSİM],[SON ÖDEME TARİHİ],[AÇIKLAMA],[FATURA TUTARI],[HİZMET BEDELİ],[TOPLAM],[DÜZENLENME TARİHİ],[DEKONT NO],[MÜŞTERİ İRTİBAT NO],[E POSTA ADRESİ],[İL],[İLÇE],[MAHALLE],[SOK],[BİNA NO],[DAİRE NO],[NEREDEN YATTI],[YATIRILAN TARİH],[EKSTRA -1],[EKSTRA -2]" & _
"from[ANAKAYIT$] where [ABONE NO] =" & Target


Set rs = con.Execute(sorgu)
[F2].CopyFromRecordset rs
End If
End Sub

bu şekilde ekledim fakat olmadı hata veriyor
Run-time error '-2147217904(80040e10)':
gerekli bir veya daha fazla parametre için girilen değer yok.
bana yardım edermisiniz.?

 

[YUSUF44]

Dosyanızı hatalı haliyle paylaşır mısınız?

 

[celcukus1]

İndir TAHSİLAT0102VRSY

Dosyayı indir TAHSİLAT0102VRSY

dosya.co

 

[celcukus1]

Dosyanızı hatalı haliyle paylaşır mısınız?

if
if else
else
mantığı hakkında müsait olunca bana bilgilerinizi aktara bilir misiniz.

 

[YUSUF44]

Dosyanızda son iki sütunun adları "EKSTRA-1" ve "EKSTRA-2" iken makroda "EKSTRA -1" ve "EKSTRA -2" olarak boşluklu yazılmış. Onları düzeltirseniz çalışacaktır. Koddaki sütun başlıklarıyla dosyanızdakiler birebir aynı olmalıdır.

 

[YUSUF44]

Koddaki if bloğunda öncelikle hedef yani B1 hücresi boşsa tablodaki eski kodların silinmesi sağlanıyor. Yani kod boş olunca, sonuç tablosu da boş oluyor.
Sonraki if yani Elseif kısmında ANAKAYIT sayfasının A sütununda B1'deki yani değerimiz EĞERSAY formülüyle aratılıyor. Eğer A sütununda girdiğimiz kod yoksa mesaj verilerek uyarıyor, eski kayıtları siliyor ve makro sonlandırılıyor.
Son Else kısmında ise yan ihedefimiz (B1 hücresi) boş değilse ve ANAKAYIT sayfasında o abone numarasının en az 1 kaydı varsa sorgu işlemi yapılarak o numaranın bilgileri listeleniyor.

Eğer A ise şunu yap
Eğer A değilse ama B ise bunu yap
Diğer durumlarda yani hem A hem de B değilse şöyle yap

Şeklinde kod düzenini kurmuştum.