Kayıt çok ağır

[rapstar_kagan_96]

Arkadaşlar biribiri ile alakalı iki adet sorum olacak.Birinci sorum şu :
Aşağıdaki kodlarla userform üzerindeki bilgileri doldurup kayıt butonuna bastıktan sonra kayıt işlemi ve çıkış işlemi çok uzun sürüyor.Kodlar şöyle :

Private Sub CommandButton1_Click()
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("a2").Value = "" Then
Range("a2").Value = 1
Range("a2").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
ActiveCell.Offset(0, 1).Value = TextBox7
ActiveCell.Offset(0, 2).Value = TextBox1
ActiveCell.Offset(0, 3).Value = TextBox2
ActiveCell.Offset(0, 4).Value = TextBox3
ActiveCell.Offset(0, 5).Value = TextBox4
ActiveCell.Offset(0, 6).Value = ComboBox3
ActiveCell.Offset(0, 7).Value = TextBox6
ActiveCell.Offset(0, 8).Value = ComboBox2
ProgressBar1.Visible = True
Dim i As Integer
For i = 1 To 1000
ProgressBar1.Value = (i / 1000) * 100
Label1000.Caption = Format(Int((i / 1000) * 100), "%0")
DoEvents
Next i
ProgressBar1.Visible = False
ThisWorkbook.Save
aciklama = "Kayıt İşlemi Başarıyla Tamamlandı"
dugme = vbOKOnly + vbInformation + vbDefaultButton1
baslik = "KAYIT"
MsgBox aciklama, dugme, baslik
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
ComboBox3.Value = ""
ComboBox2.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
ThisWorkbook.Save
Sheets("data").Select
End Sub

Progressbar ile alakalı sanıyorum ama bilmediğim için müdahale yapmadım.
İkinci sorum şu :

Bilindiği gibi; Project-VBAProject bölümünde dosyalar listeleniyor. Evdeki bilgisayarda olmuyor ama okuldaki bilgisayarda VBA sayfasını açtığımda sık sık aynı dosya iki kez görünüyor. İkisi de aynı dosya. Birinde değişiklik yaptığımda diğerinde yapılmamış oluyor. Halbuki ikisi de aynı dosya. Exceli kapatıp tekrar açtığımda düzeliyor..Sebebi ve çözümü ne olabilir?
Şimdiden teşekkürler.

 

[snx111]

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("a2").Value = "" Then
Range("a2").Value = 1
Range("a2").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
ActiveCell.Offset(0, 1).Value = TextBox7
ActiveCell.Offset(0, 2).Value = TextBox1
ActiveCell.Offset(0, 3).Value = TextBox2
ActiveCell.Offset(0, 4).Value = TextBox3
ActiveCell.Offset(0, 5).Value = TextBox4
ActiveCell.Offset(0, 6).Value = ComboBox3
ActiveCell.Offset(0, 7).Value = TextBox6
ActiveCell.Offset(0, 8).Value = ComboBox2
ProgressBar1.Visible = True
Dim i As Integer
For i = 1 To 1000
ProgressBar1.Value = (i / 1000) * 100
Label1000.Caption = Format(Int((i / 1000) * 100), "%0")
DoEvents
Next i
Application.ScreenUpdating = True
ProgressBar1.Visible = False
ThisWorkbook.Save
aciklama = "Kayıt İşlemi Başarıyla Tamamlandı"
dugme = vbOKOnly + vbInformation + vbDefaultButton1
baslik = "KAYIT"
MsgBox aciklama, dugme, baslik
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
ComboBox3.Value = ""
ComboBox2.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
ThisWorkbook.Save
Sheets("data").Select
End Sub

 

[rapstar_kagan_96]

Üstadım.İlgine ve emeğine teşekkür ediyorum ama maalesef değişen bir şey yok.

 

[ExcelF1]

Kodlarınızda bir sıkıntı görünmüyor. Progresbar ile ilgili kodları kaldırarak da deneyebilirsiniz elbet.

Bunun için şu kodları kaldırmalısınız.

ProgressBar1.Visible = True
Dim i As Integer
For i = 1 To 1000
ProgressBar1.Value = (i / 1000) * 100
Label1000.Caption = Format(Int((i / 1000) * 100), "%0")
DoEvents
Next i
ProgressBar1.Visible = False

Kayıt işleminin uzun sürmesinin sebebi olarak, dosya boyutunuza bakınız. Dosya boyutunuz yüksek veya çok fazla formüllü, şekilli vs. olması kayıt süresini etkileyecektir.

 

[rapstar_kagan_96]

Şaşılacak bir şey..Düzelmiyor bir türlü..Dosyanın boyutu 1.755.648. O kadar yüksek değil ama dosyanın içinde makro ve formül gerçekten çok..Sağlık olsun diyelim. Bu da bu güzel programın nazar boncuğu olsun ..İlgilerini ve emeklerini esirgemeyen tüm üstadlarıma çok çok teşekkür ederim.