Kodun Daha Hızlı Çalışması.

[muratnazli]

Selamlar,

Aşağıdaki kod iki dosyanın aynı isimli sayfalarının ikincisinden aldığı değeri birincisinde arayıp bulduğunda ikincisindekinin karşısına yazdıran bir kod.
Fakat çok yavaş çalışıyor. (1 Saatten fazla) Daha hızlı çalışması için ne yapılabilir.

Teşekkürler.


Sheets("stok_hareketi").Activate
son_1 = 314
For i = 4 To son_1
a = Workbooks("05_01_rapor_calismalari_1").Sheets("stok_hareketi").Cells(i, 2)
For j = 4 To son_1
b = Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Cells(j, 2)
If a = b Then
Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Cells(j, 5) = Workbooks("05_01_rapor_calismalari_1").Sheets("stok_hareketi").Cells(i, 50)
Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Cells(j, 6) = Workbooks("05_01_rapor_calismalari_1").Sheets("stok_hareketi").Cells(i, 51)
Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Cells(j, 7) = Workbooks("05_01_rapor_calismalari_1").Sheets("stok_hareketi").Cells(i, 52)
Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Cells(j, 8) = Workbooks("05_01_rapor_calismalari_1").Sheets("stok_hareketi").Cells(i, 53)
Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Cells(j, 9) = Workbooks("05_01_rapor_calismalari_1").Sheets("stok_hareketi").Cells(i, 54)
Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Cells(j, 10) = Workbooks("05_01_rapor_calismalari_1").Sheets("stok_hareketi").Cells(i, 55)
End If
Next j
Next i

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:a20c02c4cb]Application.ScreenUpdating = False
On Error Resume Next
Sheets("stok_hareketi").Activate
son_1 = 314
For i = 4 To son_1
a = Workbooks("05_01_rapor_calismalari_1").Sheets("stok_hareketi").Cells(i, 2)
satb = Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Find(Cells(i, 2).Value).Row
For c = 5 To 10
Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Cells(i, c) = Workbooks("05_01_rapor_calismalari_1").Sheets("stok_hareketi").Cells(satb, b + 45)
Next
Next
[/vb:1:a20c02c4cb]

 

[muratnazli]

Sayın leventm,

Gönderdiğiniz şekilde denedim satb değişkenine değer atanamıyor. (Empty)
Birde if sorgusunu kaldırmışsınız, a değişkeni 05_01_rapor_calismalari_1 dosyasının stok_hareketi sayfasında nasıl arattığınızı anlayamadım.

Biraz açıklayabilirseniz sevinirim.

Teşekkürler

satb = Workbooks("05_02_rapor_calismalari_1").Sheets("stok_hareketi").Find(Cells(i, 2).Value).Row

 

[Levent Menteşoğlu]

Bu iki dosyanızı kısaltarak eklermisiniz onun üzerinden gidelim.

 

[muratnazli]

Dosyaları ekledim.

 

[veyselemre]

[vb:1:e898c3a909]
Sub aktar()
Set s2 = Workbooks("05_02_rapor_calismalari").Sheets("stok_hareketi")
Set s1 = Workbooks("05_01_rapor_calismalari").Sheets("stok_hareketi")

s2sonsat = s2.Columns(2).Find("TOPLAM").Row - 1
s1sonsat = s1.Columns(2).Find("TOPLAM").Row - 1

ReDim al(s1sonsat, 7)

For x = 4 To s2sonsat
If s1.Cells(x, 2) <> "" Then
c = c + 1
al(c, 1) = s1.Cells(x, 2)
For g = 2 To 7
al(c, g) = s1.Cells(x, g + 48)
Next g
End If
Next

For y = 4 To s2sonsat
For z = 1 To c
If s2.Cells(y, 2) = al(z, 1) Then
For t = 5 To 10
s2.Cells(y, t) = al(z, t - 3)
Next
exit for
End If
Next z
Next y


End Sub
[/vb:1:e898c3a909]

 

[muratnazli]

Sayın veyselemre,

Gönderdiğiniz kod çok hızlı teşekkür ederim. Fakat anlayamadım, çok oluyorsunuz demez iseniz kod satırlarının sonuna küçük açıklamalar yazmanızı rica edebilirmiyim.

Selamlar