AccessTr.neT

(16/05/2021, 17:25)Oğuz Türkyılmaz yazdı: [ -> ]@feraz hocam kayıt ekleme sorununu hallettim. Güncelleme ile ilgili sorunu nasıl aşabilirim. Güncelleme yapmak istediğimde koda whatapp sayfasında hangi satırı güncelleyeceğini, nasıl gösterebilirim. End(3) dolayısıyla güncellemede de yeni kayıt yapar gibi en son satıra kaydediyor.

Kod:

  End With
       
        If TextBox_Gsm.Value <> "" Then
             
            TextBox_Gsm.Value = Replace(Replace(Replace(Replace(TextBox_Gsm.Value, "(", ""), ")", ""), " ", ""), "-", "")
            ThisWorkbook.Worksheets("Ana_Sayfa").Cells(Guncelle, 30).NumberFormat = "@"
            ThisWorkbook.Worksheets("Ana_Sayfa").Cells(Guncelle, 30) = "+90" & TextBox_Gsm.Value
       
            ThisWorkbook.Worksheets("WHATSAPP").Unprotect ("171717")
            ThisWorkbook.Worksheets("WHATSAPP").Cells(Rows.Count, 1).End(3)(2, 1).NumberFormat = "@"
            ThisWorkbook.Worksheets("WHATSAPP").Cells(Rows.Count, 1).End(3)(2, 1) = "+90" & TextBox_Gsm.Value
            ThisWorkbook.Worksheets("WHATSAPP").Protect
       
        Else
       
        End If

Zaten bu soruyu bekliyordum abey sırada
Find kodu ile yada dictionary yada döngü ile satır numara buldurulur gerekli işlem yapılır.
Yeni konu açın çözelim abey

---

(16/05/2021, 17:25)Oğuz Türkyılmaz yazdı: [ -> ]ThisWorkbook.Worksheets("WHATSAPP").Protect

Burayada "şifre" yazılacak abey protect ten sonra boşluk bırakıp.

@feraz hocam çok uğraştıracak gerek var mı diye sorgulamaya başladım. Sizce hücrede 0 değeri sorun yaratır mı. Whatsapp tan mesaj gönderilirken. Yani o hücrede 0 değeri whatsappın orda takılmasına yada vakit kaybetmesine yol açar mı. Deneyemiyorum şu anda onun için soruyorum.

(16/05/2021, 18:04)Oğuz Türkyılmaz yazdı: [ -> ]@feraz hocam çok uğraştıracak gerek var mı diye sorgulamaya başladım. Sizce hücrede 0 değeri sorun yaratır mı. Whatsapp tan mesaj gönderilirken. Yani o hücrede 0 değeri whatsappın orda takılmasına yada vakit kaybetmesine yol açar mı. Deneyemiyorum şu anda onun için soruyorum.

Abey şimdi ben bir dictionary ile kod yazarım silme,güncelleme ve ekleeme için hepsinde kullanırsınız.

Formül sorun yaratıyor feraz hocam zaten hücrede 0 olmuş yada boş olmuş farketmiyor. Whatsapp yine göndermeye çalışıyor. Fakat formülle yada kodla ne yaparsak yapalım boş hücrede çalışmasını bir şekilde engellemek gerekiyor. Ya da hiç istemesem de whatsapp sayfasını filtreleyip dolu olanları başka bir sayfaya yapıştırıp filtresizmiş (filtrelemede resimler kopyalanmıyordu)gibi o sayfadan gönderim yapacağım.

(16/05/2021, 18:35)Oğuz Türkyılmaz yazdı: [ -> ]Formül sorun yaratıyor feraz hocam zaten hücrede 0 olmuş yada boş olmuş farketmiyor

Göndermeye çalışıyorsa koda if ile 0 ise yada boş ise yada formüllü ise diye koşul eklenir.
O konu için extra konu açın bakalım abey.

---

Resimlerde gösterdim.


https://resim.accesstr.net/do.php?img=11043


https://resim.accesstr.net/do.php?img=11044


https://resim.accesstr.net/do.php?img=11045


https://resim.accesstr.net/do.php?img=11046

Sub Whatsap_ekle_sil_guncelle()



Dim dic As Object, sonAna As Long, keyy As String, kac As Long

Dim syfAna As Worksheet, dizi(), i As Long, say As Long, hatalimi As Boolean



Set dic = CreateObject("Scripting.dictionary")

Set syfAna = ThisWorkbook.Worksheets("Ana_Sayfa")



Application.ScreenUpdating = False

sonAna = syfAna.Range("A:A").Find("*", , , , , xlPrevious).Row

hatalimi = False



With ThisWorkbook.Worksheets("WHATSAPP")

  .Unprotect "171717"

    .Range("A2:A" & Rows.Count).ClearContents

    

    If sonAna < 2 Then

        hatalimi = True: GoTo son

    End If



    kac = WorksheetFunction.CountA(syfAna.Range("A2:A" & Rows.Count))

    If kac = 1 Then

        .Range("A2").Value = syfAna.Cells(sonAna, "AD").Value

        GoTo son

    End If

    

    dizi = syfAna.Range("AD2:AD" & sonAna).Value

    ReDim arr(1 To UBound(dizi), 1 To 1)

    say = 0

    

    For i = LBound(dizi) To UBound(dizi)

      keyy = CStr(dizi(i, 1))

      If Not dic.exists(keyy) Then

          say = say + 1

          dic.Add keyy, 0

          arr(say, 1) = keyy

      End If

    Next

    

    If dic.Count > 0 Then .Range("A2").Resize(dic.Count, 1).Value = arr

son:

Application.ScreenUpdating = True

.Protect "171717"

End With

On Error Resume Next

If hatalimi = True Then

    MsgBox "Kaydedilecek yada güncellenecek yada silinecek veri yok.", vbCritical, "Hata"

Else

    MsgBox "islem tamam.", vbInformation, "Bilgi"

End If

Set sic = Nothing: Set syfAna = Nothing: Erase arr: Erase dizi

End Sub

Bence whatapp sayfadan yollamak sakıncalı.
Yolladığım kodla gönderecekseniz kodu kısaltınca eklerim,uzamış biraz