Merhaba arkadaşlar,
0-360 arasında çeşitli aralıklarla bulunan sayılara aralıklarına göre harf ataması yapması için bir makro yazmaya çalıştım. Fakat satır sayısı 200000 lere çıktığında makro yavaş çalışıyor. Bu yazdığım makroyu hızlandırmak için ilave satır önerilerinizi veya yapmaya çalıştığım şeyi daha az satırla yapabileceğim makro kodu önerilerinizi alabilir miyim?
makro şöyle:
0-360 arasında çeşitli aralıklarla bulunan sayılara aralıklarına göre harf ataması yapması için bir makro yazmaya çalıştım. Fakat satır sayısı 200000 lere çıktığında makro yavaş çalışıyor. Bu yazdığım makroyu hızlandırmak için ilave satır önerilerinizi veya yapmaya çalıştığım şeyi daha az satırla yapabileceğim makro kodu önerilerinizi alabilir miyim?
makro şöyle:
Kod:
Private Sub CommandButton1_Click()
Dim i As Long
For i = 1 To 215000 Step 1
If Cells(i, 1) = "" Then
Cells(i, 2) = ""
ElseIf Cells(i, 1) < 11.25 Or Cells(i, 1) > 348.25 Then
Cells(i, 2) = "A"
ElseIf Cells(i, 1) > 11.25 And Cells(i, 1) < 33.75 Then
Cells(i, 2) = "B"
ElseIf Cells(i, 1) > 33.75 And Cells(i, 1) < 56.25 Then
Cells(i, 2) = "C"
ElseIf Cells(i, 1) > 56.25 And Cells(i, 1) < 78.75 Then
Cells(i, 2) = "D"
ElseIf Cells(i, 1) > 78.75 And Cells(i, 1) < 101.25 Then
Cells(i, 2) = "E"
ElseIf Cells(i, 1) > 101.25 And Cells(i, 1) < 123.75 Then
Cells(i, 2) = "F"
ElseIf Cells(i, 1) > 123.75 And Cells(i, 1) < 146.25 Then
Cells(i, 2) = "G"
ElseIf Cells(i, 1) > 146.25 And Cells(i, 1) < 168.75 Then
Cells(i, 2) = "H"
ElseIf Cells(i, 1) > 168.75 And Cells(i, 1) < 191.25 Then
Cells(i, 2) = "I"
ElseIf Cells(i, 1) > 191.25 And Cells(i, 1) < 213.75 Then
Cells(i, 2) = "J"
ElseIf Cells(i, 1) > 213.75 And Cells(i, 1) < 236.25 Then
Cells(i, 2) = "K"
ElseIf Cells(i, 1) > 236.25 And Cells(i, 1) < 258.75 Then
Cells(i, 2) = "L"
ElseIf Cells(i, 1) > 258.75 And Cells(i, 1) < 281.25 Then
Cells(i, 2) = "M"
ElseIf Cells(i, 1) > 281.25 And Cells(i, 1) < 303.75 Then
Cells(i, 2) = "N"
ElseIf Cells(i, 1) > 303.75 And Cells(i, 1) < 326.25 Then
Cells(i, 2) = "O"
ElseIf Cells(i, 1) > 326.25 And Cells(i, 1) < 348.75 Then
Cells(i, 2) = "P"
End If
Next i
End Sub