MAKRO HIZLANDIRMA ( PROF ARKADAŞLARDAN YARDIM LÜTFEN )

[musa yüksel]

Merhaba ,
yazmış olduğum uzunca bi makro uygulaması var
bazı yerleri çok yavaş çalışıyor , ağ da veri topladığımız biz excel dosyasını açıp veri işliyor sonra kapatıyor , ve bu işlem yaklaşık 17-18 saniye sürüyor
aşağıda paylaşmış olduğum makroda değişiklikler yapıp hızlandırma şansım var mı

If Range("C1") = "" Then
        MsgBox "Çalışmadım..FİRMA KODU YAZ"
        Exit Sub
    End If
   
    Application.ScreenUpdating = False
    Workbooks.Open Filename:="\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm"
    Sheets("SİPARİŞ NO").Select
    Range("B2") = Range("B2") + 1
    ActiveWorkbook.Save
    Workbooks("SİPARİŞ NUMARASI.xlsm").Close
   
    ActiveWorkbook.UpdateLink Name:="\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm", _
        Type:=xlExcelLinks
       
    Application.ScreenUpdating = True

 

[Kumpasta]

ne kadar değişiklik yapabilir bilmiyorum aşağıdaki şekilde denermisiniz?

If Range("C1").Value = "" Then
    MsgBox "Çalışmadım..FİRMA KODU YAZ"
    Exit Sub
End If

Application.ScreenUpdating = False

Dim wb As Workbook
Set wb = Workbooks.Open(Filename:="\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm")

With wb.Sheets("SİPARİŞ NO")
    .Range("B2").Value = .Range("B2").Value + 1
End With

wb.Close SaveChanges:=True

ActiveWorkbook.UpdateLink Name:="\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm", Type:=xlExcelLinks

Application.ScreenUpdating = True

 

[musa yüksel]

ne kadar değişiklik yapabilir bilmiyorum aşağıdaki şekilde denermisiniz?

If Range("C1").Value = "" Then
    MsgBox "Çalışmadım..FİRMA KODU YAZ"
    Exit Sub
End If

Application.ScreenUpdating = False

Dim wb As Workbook
Set wb = Workbooks.Open(Filename:="\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm")

With wb.Sheets("SİPARİŞ NO")
    .Range("B2").Value = .Range("B2").Value + 1
End With

wb.Close SaveChanges:=True

ActiveWorkbook.UpdateLink Name:="\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm", Type:=xlExcelLinks

Application.ScreenUpdating = True

Maalesef değişin birsey olmadı , hız olarak aynı

 

[musa yüksel]

ne kadar değişiklik yapabilir bilmiyorum aşağıdaki şekilde denermisiniz?

If Range("C1").Value = "" Then
    MsgBox "Çalışmadım..FİRMA KODU YAZ"
    Exit Sub
End If

Application.ScreenUpdating = False

Dim wb As Workbook
Set wb = Workbooks.Open(Filename:="\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm")

With wb.Sheets("SİPARİŞ NO")
    .Range("B2").Value = .Range("B2").Value + 1
End With

wb.Close SaveChanges:=True

ActiveWorkbook.UpdateLink Name:="\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm", Type:=xlExcelLinks

Application.ScreenUpdating = True

SİPARİŞ NUMARASI.xlsm dosyasının açılması çok uzun sürüyor onu hızlandırma şansımız yok mu arka planda hazır beklesin gibi auto sub falan

birden çok pc den veri girildiği için SİPARİŞ NUMARASI.xlsm salt okunura da düşmemesi gerekiyor :S

 

[Kumpasta]

Anladım da bilgiler çok kısıtlı.
Ayrıca sipariş numarası isimli sistemi access ten yapsanız daha sağlıklı olacaktır.
O konuda hiç bilgim yok

 

[Trilenium]

Dosya Network üzerinde olduğu için (yapısı gereği) yavaş açılabilir.


1.önerim dosyayı Local de temp klasöre kopyalayıp güncelleme sonrası tekrar network üzerine kopyalatmak olacaktır.

2.önerim MDB ye geçin daha hızlı kullanırsınız

 

[Korhan Ayhan]

Aşağıdaki iki kodu deneyiniz.

Test_1 isimli kodun hız olarak avantajlı olacağını düşünüyorum. Eğer öyle olursa kendi kodlarınızı uyarlarsınız.

Option Explicit

Sub Test_1()
    Dim File_Path As String, My_File As Object, Process_Time As Double
    
    Process_Time = Timer
    
    File_Path = "\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm"
    Set My_File = GetObject(File_Path)
    'Windows(My_File.Name).Visible = True
    
    My_File.Close 0
    
    MsgBox Timer - Process_Time
End Sub

Sub Test_2()
    Dim File_Path As String, My_File As Object, Process_Time As Double
    
    Process_Time = Timer
    
    File_Path = "\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm"
    Set My_File = Workbooks.Open(File_Path)
    
    My_File.Close 0
    
    MsgBox Timer - Process_Time
End Sub

 

[musa yüksel]

Dosya Network üzerinde olduğu için (yapısı gereği) yavaş açılabilir.


1.önerim dosyayı Local de temp klasöre kopyalayıp güncelleme sonrası tekrar network üzerine kopyalatmak olacaktır.

2.önerim MDB ye geçin daha hızlı kullanırsınız

Mdb ile ilgili hiç bilgim yok müsait bir zaman da araştıracağım inşallah teşekkürler

 

[musa yüksel]

Aşağıdaki iki kodu deneyiniz.

Test_1 isimli kodun hız olarak avantajlı olacağını düşünüyorum. Eğer öyle olursa kendi kodlarınızı uyarlarsınız.

Option Explicit

Sub Test_1()
    Dim File_Path As String, My_File As Object, Process_Time As Double
   
    Process_Time = Timer
   
    File_Path = "\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm"
    Set My_File = GetObject(File_Path)
    'Windows(My_File.Name).Visible = True
   
    My_File.Close 0
   
    MsgBox Timer - Process_Time
End Sub

Sub Test_2()
    Dim File_Path As String, My_File As Object, Process_Time As Double
   
    Process_Time = Timer
   
    File_Path = "\\hesap\deneme\veri\SİPARİŞ NUMARASI.xlsm"
    Set My_File = Workbooks.Open(File_Path)
   
    My_File.Close 0
   
    MsgBox Timer - Process_Time
End Sub

Şirkete geçince test 1 deneyeceğim ama nasıl kullanacağım hakkında pek fikrim yok

Temp klasörüne kopya oluşturup kapatıyor mu tam anlayamadım my file name dosyası kopya olan dosyamı, dosya kapandıktan sonra networkte dosya içeriği değişecek mi

 

[musa yüksel]

Test 1 i denedim yarım saniye hızlandırdı, temp klasörüne kopyalayip deneyeceğim ama daha önce hiç x dosyasını su klasöre kopyala tarzında makro yazmadım, hazırda olan var mi

 

[Korhan Ayhan]

Hız kaybı network ortamı olmasından dolayıdır. Dosya boyutuda önemli tabi..