[Yardım]  Topla Kodu Geç Sonuç Veriyor

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Topla Kodu Geç Sonuç Veriyor

İleti#1)  officer08 » 17 Oca 2023 10:57

For döngüsünde oluşturduğum koşullu toplama kodu çok geç cevap veriyor. Kod şu şekilde: eğer "B" sütunundaki hücre dolu ise denk gelen "F" ve "G" sütunlarındaki hücreleri topla ve "H" sütununa yaz, boşsa "H" boş kalsın. Bu işlemi 50000 satıra kadar yap. 50000 satır olmasından kaynaklı mı anlamadım.
------------------------------- aşağıdaki gibi geç sonuç alıyorum
Sub topla_database()
Dim i As Long, tpl As Double
For i = 2 To 50000
If Cells(i, "B") = "" Then
Cells(i, "H") = ""
Else
tpl = Cells(i, "F").Value + Cells(i, "G").Value
Cells(i, 8).Value = tpl
End If
Next
End Sub
---------------------------------Böyle yapınca daha hızlı sonuç alıyorum ancak koşul olmayınca "B" boşsa "J" sıfır yazdırıyor.
Sub topla_database()
Dim i As Long, tpl As Double
For i = 2 To 50000
tpl = Cells(i, "F").Value + Cells(i, "G").Value
Cells(i, 8).Value = tpl
Next
End Sub
Kullanıcı avatarı
officer08
Yeni Başlamış
 
Kayıt: 29 Arl 2022 00:41
Meslek: Serbest Meslek
Yaş: 43
İleti: 10
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kütahya

Yıllık Maaş Bordrosu Hesaplama 2022

Cevap: Topla Kodu Geç Sonuç Veriyor

İleti#2)  Yken » 18 Oca 2023 07:52

Kod: Tümünü seç
Sub topla_database()
Dim i As Long, tpl As Double
For i = 2 To 50000
tpl = Cells(i, "F").Value + Cells(i, "G").Value
If Cells(i, "B") <> "" And tpl > 0 Then
Cells(i, "H").Value = tpl
End If
Next
End Sub
Kullanıcı avatarı
Yken
Siteye Alışmış
 
Kayıt: 07 Kas 2014 11:06
Meslek: Muhasebe
Yaş: 57
İleti: 114
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Topla Kodu Geç Sonuç Veriyor

İleti#3)  officer08 » 19 Oca 2023 10:32

Yken çok teşekkür ederim.
Kullanıcı avatarı
officer08
Yeni Başlamış
 
Kayıt: 29 Arl 2022 00:41
Meslek: Serbest Meslek
Yaş: 43
İleti: 10
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kütahya

Cevap: Topla Kodu Geç Sonuç Veriyor

İleti#4)  officer08 » 19 Oca 2023 11:19

Aynı konu olarak düşündüğüm, yani formulün geç çalışması ile ilgili olarak aşağıdaki kaydet kodlarımın sonuçlanması 7-8 saniye sürüyor bu normalmidir yada ben nerede hata yaptım yardımcı olabilirmisiniz.

Private Sub CommandButton1_Click()
Set S1 = Sheets("database")
If TextBox3 <> "" Then
ss = S1.Cells(Rows.Count, 1).End(3).Row
S1.Cells(ss, 1) = ss
S1.Cells(ss + 1, 2) = TextBox3.Text
S1.Cells(ss + 1, 5) = ComboBox1.Text
S1.Cells(ss + 1, 4) = TextBox1.Text
If OptionButton1 = True Then
S1.Cells(ss + 1, 6) = "1"
ElseIf OptionButton2 = True Then
S1.Cells(ss + 1, 7) = "1"
End If
End If

MsgBox ("Kayıt Tamamlandı")
End Sub
Kullanıcı avatarı
officer08
Yeni Başlamış
 
Kayıt: 29 Arl 2022 00:41
Meslek: Serbest Meslek
Yaş: 43
İleti: 10
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kütahya

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Topla Kodu Geç Sonuç Veriyor

İleti#5)  Yken » 19 Oca 2023 13:35

officer08 yazdı:Aynı konu olarak düşündüğüm, yani formulün geç çalışması ile ilgili olarak aşağıdaki kaydet kodlarımın sonuçlanması 7-8 saniye sürüyor bu normalmidir yada ben nerede hata yaptım yardımcı olabilirmisiniz.

Private Sub CommandButton1_Click()
Set S1 = Sheets("database")
If TextBox3 <> "" Then
ss = S1.Cells(Rows.Count, 1).End(3).Row
S1.Cells(ss, 1) = ss
S1.Cells(ss + 1, 2) = TextBox3.Text
S1.Cells(ss + 1, 5) = ComboBox1.Text
S1.Cells(ss + 1, 4) = TextBox1.Text
If OptionButton1 = True Then
S1.Cells(ss + 1, 6) = "1"
ElseIf OptionButton2 = True Then
S1.Cells(ss + 1, 7) = "1"
End If
End If

MsgBox ("Kayıt Tamamlandı")
End Sub

Bana normal görünüyor.
Kullanıcı avatarı
Yken
Siteye Alışmış
 
Kayıt: 07 Kas 2014 11:06
Meslek: Muhasebe
Yaş: 57
İleti: 114
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Topla Kodu Geç Sonuç Veriyor

İleti#6)  officer08 » 19 Oca 2023 16:08

Teşekkür ederim kod kaynaklı değilse yapacak bişey yok.
Peki Yken bu koddaki

S1.Cells(ss + 1, 4) = TextBox1.Text

bu kısmı ilgili hücreye kısa tarih biçimi ile mesela 01.01.2023 gibi yazdırmak için ne yapmalıyım.
Kullanıcı avatarı
officer08
Yeni Başlamış
 
Kayıt: 29 Arl 2022 00:41
Meslek: Serbest Meslek
Yaş: 43
İleti: 10
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kütahya

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Topla Kodu Geç Sonuç Veriyor

İleti#7)  Yken » 19 Oca 2023 16:50

Kod: Tümünü seç
S1.Cells(ss + 1, 4) = Format(TextBox1.Text, "dd.mm.yyyy")
Kullanıcı avatarı
Yken
Siteye Alışmış
 
Kayıt: 07 Kas 2014 11:06
Meslek: Muhasebe
Yaş: 57
İleti: 114
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Topla Kodu Geç Sonuç Veriyor

İleti#8)  officer08 » 19 Oca 2023 17:44

Seni çok yordum Yken kusura bakma çok teşekkür ederim. Dediğini uyguladım database sayfasına tarihi yine kaydediyor ancak gelişmiş filtrede aktarma yaptırmıyor.
Fakat deneme amaçlı database sayfasında tarihi elle manuel yazınca oluyor. Sence neden olur.
Kullanıcı avatarı
officer08
Yeni Başlamış
 
Kayıt: 29 Arl 2022 00:41
Meslek: Serbest Meslek
Yaş: 43
İleti: 10
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kütahya

Cevap: Topla Kodu Geç Sonuç Veriyor

İleti#9)  officer08 » 20 Oca 2023 00:34

Aşağıdaki kod ile sorunu çözdüm belki birisine daha yardımcı olur.
Normalde TextBox ile kaydedilen tarih metin olarak kaydedilirken bu şekilde "gg.aa.yyyy" formatında tarih olarak kaydediliyor. Ve tablonuzdan gelişmiş filtre yaparken sorun yaşamıyorsunuz.

S1.Cells(ss + 1, 4) = CDate(TextBox1.Text)
Kullanıcı avatarı
officer08
Yeni Başlamış
 
Kayıt: 29 Arl 2022 00:41
Meslek: Serbest Meslek
Yaş: 43
İleti: 10
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kütahya

Cevap: Topla Kodu Geç Sonuç Veriyor

İleti#10)  Ömer BARAN » 23 Oca 2023 04:08

Hız istiyorsanız, bir de bunu deneyin.

Kod: Tümünü seç
Sub F_G_TOPLA()
Dim son As Long, a As Long
Dim f As Double, g As Double, tpl As Double
imza = "::.. Ömer BARAN ..::": satir = vbLf & vbLf
bekleriz = "Www.ExcelDepo.Com" & satir & "sitesine de bekleriz."
son = Cells(Rows.Count, 2).End(3).Row
veri = Range("B2:G" & son).Value2
ReDim XD(1 To son - 1)
For a = 1 To son - 1
    f = veri(a, 5): g = veri(a, 6): tpl = f + g
    If veri(a, 1) <> "" And tpl > 0 Then XD(a) = tpl
Next: [H2].Resize(son - 1, 1) = Application.Transpose(XD)
MsgBox "Bitti.." & satir & bekleriz, vbInformation, imza
End Sub
☾✭ İnadına TÜRKÇE ✭☽

Ekseriyetle, Www.ExcelDepo.Com sitesindeyim.

.
Kullanıcı avatarı
Ömer BARAN
Siteye Alışmış
 
Adı Soyadı:ÖMER BARAN
Kayıt: 29 Oca 2013 18:17
Konum: ANKARA
Meslek: EMEKLİ
Yaş: 59
İleti: 372
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANKARA / ÇANKAYA


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 4 misafir

Bumerang - Yazarkafe