Skip to main content

AccessTr.neT


Userform Dan Excel Sayfasına Kayıt Neden Zaman Alıyor.

Oğuz Türkyılmaz
Oğuz Türkyılmaz
1
535

Userform Dan Excel Sayfasına Kayıt Neden Zaman Alıyor.

Çözüldü #1
Merhaba
Ana Sayfada Masraf Kayıt Formuna tıklayarak Userformdan Excel sayfasına kayıt yaparken normalde 1 saniyede biten kayıt ne olduysa 5-6 saniye sürmeye başladı.30 küsur kayıt yaptım ve  Toplamda  7 alanım var her alanda kayıt yaparken birer saniye bekliyor. Vba Kodlarımdan yana sıkıntı olabilir mi yada bu durumu aşmam daha hızlı çalışabilmesi için için ne yapmam gerekir. Yardımcı olmanızı rica ederim. 

[Resim: do.php?img=10717]

[Resim: do.php?img=10718]

Kod:
Dim SonSatir, aranan, sil_satir As Variant


Private Sub btn_Kapat_Click()

Unload UserForm1


End Sub

Private Sub btn_KayitAra_Click()

On Error GoTo Bitir

aranan = InputBox("Aramak İstediğiniz ID Numarasını Giriniz...", " Masraf Kaydı Arama Formu", " ")
Range("A:A").Find(aranan).Select

sil_.satir = ActiveCell.Row


txt_ID.Value = Worksheets("Ana Sayfa").Cells(sil_satir, 1)
txt_MasrafTarihi.Value = Worksheets("Ana Sayfa").Cells(sil_satir, 2)
cmb_Firma.Value = Worksheets("Ana Sayfa").Cells(sil_satir, 3)
txt_BelgeNo.Value = Worksheets("Ana Sayfa").Cells(sil_satir, 4)
cmb_MasrafTuru.Value = Worksheets("Ana Sayfa").Cells(sil_satir, 5)
txt_Aciklama.Value = Worksheets("Ana Sayfa").Cells(sil_satir, 6)
txt_MasrafTutari.Value = Worksheets("Ana Sayfa").Cells(sil_satir, 7)

Exit Sub

Bitir: MsgBox "Aranan Kayıt Bulunamadı"

End Sub

Private Sub btn_KayitEkle_Click()



If txt_MasrafTarihi <> "" And txt_BelgeNo <> "" And cmb_Firma <> "" And cmb_MasrafTuru <> "" And txt_MasrafTutari <> "" Then

    If IsNumeric(txt_MasrafTutari.Value) Then
        SonSatir = WorksheetFunction.CountA(Worksheets("Ana Sayfa").Range("A:A")) + 1
        
      
        If SonSatir = 2 Then
            Worksheets("Ana Sayfa").Cells(SonSatir, 1) = 1
            Worksheets("Ana Sayfa").Cells(SonSatir, 2) = txt_MasrafTarihi
            Worksheets("Ana Sayfa").Cells(SonSatir, 3) = cmb_Firma
            Worksheets("Ana Sayfa").Cells(SonSatir, 4) = txt_BelgeNo
            Worksheets("Ana Sayfa").Cells(SonSatir, 5) = cmb_MasrafTuru
            Worksheets("Ana Sayfa").Cells(SonSatir, 6) = txt_Aciklama
            Worksheets("Ana Sayfa").Cells(SonSatir, 7) = CDbl(txt_MasrafTutari.Value)
        
        Else
            Worksheets("Ana Sayfa").Cells(SonSatir, 1) = Worksheets("Ana Sayfa").Cells(SonSatir - 1, 1) + 1
            Worksheets("Ana Sayfa").Cells(SonSatir, 2) = txt_MasrafTarihi
            Worksheets("Ana Sayfa").Cells(SonSatir, 3) = cmb_Firma
            Worksheets("Ana Sayfa").Cells(SonSatir, 4) = txt_BelgeNo
            Worksheets("Ana Sayfa").Cells(SonSatir, 5) = cmb_MasrafTuru
            Worksheets("Ana Sayfa").Cells(SonSatir, 6) = txt_Aciklama
            Worksheets("Ana Sayfa").Cells(SonSatir, 7) = CDbl(txt_MasrafTutari.Value)
        End If
        
    Else
        MsgBox " Masraf Tutarı Hanesine Sadece Rakam Girilebilir "
        GoTo SoN:
    End If

Else
    MsgBox " Dikkat...! Tanımlı Alanlar Boş Geçilemez  "

End If
SoN:

txt_MasrafTarihi = ""
txt_BelgeNo = ""
cmb_Firma = ""
cmb_MasrafTuru = ""
txt_Aciklama = ""
txt_MasrafTutari = ""

txt_MasrafTarihi.SetFocus


End Sub


Private Sub Frame2_Click()

End Sub

Private Sub txt_MasrafTarihi_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txt_MasrafTarihi = Replace(txt_MasrafTarihi, ".", "")
txt_MasrafTarihi = Left(txt_MasrafTarihi, 2) & "." & Mid(txt_MasrafTarihi, 3, 2) & "." & Right(txt_MasrafTarihi, 4)
End Sub

.rar AWA.rar (Dosya Boyutu: 103,12 KB | İndirme Sayısı: 7)
Access Çekirgesi 
[Resim: img-cray.gif]


Son Düzenleme: 13/02/2021, 20:31, Düzenleyen: Oğuz Türkyılmaz.
Cevapla
#2
Sorun Office 2019 dan kaynaklanmış sanırım deneme için bu sürümü kaldırıp kaldırıp 2016 yükledim her şeyi baştan tekrar yazdım Şu an sorunsuz ve hızlı bir şekilde çalışıyor. Konuyu taşıyabilirsiniz. Teşekkürler.
Access Çekirgesi 
[Resim: img-cray.gif]


Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task