Programımı daha hızlı çalıştırabilirmiyim.

[blazer2004]

Merhaba arkadaşlar,saygı değer hocalarım aşağıdaki kodun daha hızlı çalışması için ne yapabilirim yardımcı olabilirmisiniz.

sub kod()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set x = ThisWorkbook.Sheets(4)
Set ktp = Workbooks.Open(ThisWorkbook.Path & "\" & x.ComboBox1.Text)
Set xx = ktp.Sheets(1)
ThisWorkbook.Activate
If Mid(xx.Cells(1, 6).Value, 2, 6) <> Trim("alışma") Then
xx.Columns(6).Delete
End If

For k = 4 To x.Cells(65536, "C").End(xlUp).Row
For i = 2 To xx.Cells(65536, "A").End(xlUp).Row
If WorksheetFunction.CountIf(x.Range("c51:C" & k), x.Range("C" & k)) > 1 Then
x.Cells(k, "C").Interior.ColorIndex = 3
End If
If WorksheetFunction.CountIf(xx.Range("A2:A" & i), x.Range("C" & k)) = 1 Then
For a = 0 To xx.Cells(65536, "A").End(xlUp).Row
If Not xx.Cells(i + a, "A").Value <> x.Cells(k, "C").Value Then

For v = 1 To 80
If Mid(x.Cells(1, v), 2, 3) = Mid(x.ComboBox1.Value, 5, 3) Or Mid(x.Cells(1, v), 1, 3) = Mid(x.ComboBox1.Value, 4, 3) Then

If x.Cells(4, v + 2).Value > 0 Then
onay = MsgBox("Hücrede veri var!Tekrar yüklenmesini istermisiniz? ", vbYesNo, "Onay")
If onay = vbYes Then
GoTo d:
Else
Exit Sub
End If
Else
d:
xx.Range("A" & i & ":A" & i + a).Interior.ColorIndex = 6
x.Cells(k, v + 1) = Application.Sum(xx.Range("F" & i & ":F" & i + a).Value)
x.Cells(k, v) = Application.Sum(xx.Range("G" & i & ":G" & i + a).Value)



End If
End If
Next v
End If
Next a
End If
Next i
Next k


Workbooks(yol).Close True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
end sub

 

[Asri]

Örnek dosyanız ile berebar olur ise neden olmasın.

dosya.tc ye yükleyebilir siniz.