run time error-9/-Out of range hatası

[gencoglu27]

Merhaba arkadaşlar,
Aşağıdaki kod 1-34 arası sayılar için 278.000 satırı 4 dakkikada yazabilmekte, kombinasyon oluşturmakta fakat sayıları 40 a yada 54 e çıkarınca "Run time error 9-out of range" hatası vermekte.. ofis 2007 de sayfa satır sayısı 1048.000 kadar.
Kod a bir ilave yaparak sayfa1 e 500.000 yazdıktan sonra 2. sayfaya..3.sayfaya geçsin istiyorum..bunun için yardımcı olur musunuz..? Teşekkürler.

Sub lotto34()

Dim X1 As Integer, X2 As Integer, X3 As Integer, X4 As Integer, X5 As Integer
Dim rowx As Long
Dim i As Long, m As Long, s As Long, k As Long, p As Long
Dim vData As Variant
Dim vResults As Variant

i = Cells(Rows.Count, "A").End(3).Row
m = Cells(Rows.Count, "B").End(3).Row
s = Cells(Rows.Count, "C").End(3).Row
k = Cells(Rows.Count, "D").End(3).Row
p = Cells(Rows.Count, "E").End(3).Row
rowx = 1
Range("G:K").ClearContents

'Capture activesheet data
vData = Range(Cells(1, 1), Cells(Cells(Rows.Count, "E").End(3).Row, 5))

'Set up results data
ReDim vResults(1 To 478256, 1 To 5)

For X1 = 1 To i
For X2 = 1 To m
For X3 = 1 To s
For X4 = 1 To k
For X5 = 1 To p
If Not vData(X1, 1) = vData(X2, 2) Then
If Not vData(X2, 2) = vData(X3, 3) Then
If Not vData(X3, 3) = vData(X4, 4) Then
If Not vData(X1, 1) = vData(X3, 3) Then
If Not vData(X1, 1) = vData(X4, 4) Then
If Not vData(X2, 2) = vData(X4, 4) Then
If Not vData(X1, 1) = vData(X5, 5) Then
If Not vData(X2, 2) = vData(X5, 5) Then
If Not vData(X3, 3) = vData(X5, 5) Then
If Not vData(X4, 4) = vData(X5, 5) Then
If vData(X1, 1) < vData(X2, 2) And vData(X2, 2) < vData(X3, 3) And vData(X3, 3) < vData(X4, 4) And vData(X4, 4) < vData(X5, 5) Then
'Write results data
vResults(rowx, 1) = vData(X1, 1)
vResults(rowx, 2) = vData(X2, 2)
vResults(rowx, 3) = vData(X3, 3)
vResults(rowx, 4) = vData(X4, 4)
vResults(rowx, 5) = vData(X5, 5)
rowx = rowx + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next
Next
Next
Next
Next

'Display results
Range("G1").Resize(478256, 5) = vResults

End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin. Muhtemelen çalışma süreside azalacaktır.

Sub lotto34()
Dim X1 As Integer, X2 As Integer, X3 As Integer, X4 As Integer, X5 As Integer
Dim rowx As Long
Dim i As Long, m As Long, s As Long, k As Long, p As Long
Dim vData As Variant
i = Cells(Rows.Count, "A").End(3).Row
m = Cells(Rows.Count, "B").End(3).Row
s = Cells(Rows.Count, "C").End(3).Row
k = Cells(Rows.Count, "D").End(3).Row
p = Cells(Rows.Count, "E").End(3).Row
c = 0
'Capture activesheet data
vData = Range(Cells(1, 1), Cells(Cells(Rows.Count, "E").End(3).Row, 5))
sayfa = Array("sayfa1", "sayfa2", "sayfa3", "sayfa4", "sayfa5")
For a = 0 To UBound(sayfa)
Sheets("" & sayfa(a)).Range("G:K").ClearContents
Next
'Set up results data
For X1 = 1 To i
For X2 = 1 To m
For X3 = 1 To s
For X4 = 1 To k
For X5 = 1 To p
If Not vData(X1, 1) = vData(X2, 2) Then
If Not vData(X2, 2) = vData(X3, 3) Then
If Not vData(X3, 3) = vData(X4, 4) Then
If Not vData(X1, 1) = vData(X3, 3) Then
If Not vData(X1, 1) = vData(X4, 4) Then
If Not vData(X2, 2) = vData(X4, 4) Then
If Not vData(X1, 1) = vData(X5, 5) Then
If Not vData(X2, 2) = vData(X5, 5) Then
If Not vData(X3, 3) = vData(X5, 5) Then
If Not vData(X4, 4) = vData(X5, 5) Then
If vData(X1, 1) < vData(X2, 2) And vData(X2, 2) < vData(X3, 3) And vData(X3, 3) < vData(X4, 4) And vData(X4, 4) < vData(X5, 5) Then
'Write results data
If rowx Mod [B][COLOR=red]500000[/COLOR][/B] = 0 Then
Set s1 = Sheets("" & sayfa(c))
c = c + 1
rowx = 0
End If
rowx = rowx + 1
s1.Cells(rowx, "g") = vData(X1, 1)
s1.Cells(rowx, "h") = vData(X2, 2)
s1.Cells(rowx, "I") = vData(X3, 3)
s1.Cells(rowx, "j") = vData(X4, 4)
s1.Cells(rowx, "k") = vData(X5, 5)
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next
Next
Next
Next
Next
End Sub

 

[Orion1]

Merhaba arkadaşlar,
Aşağıdaki kod 1-34 arası sayılar için 278.000 satırı 4 dakkikada yazabilmekte, kombinasyon oluşturmakta fakat sayıları 40 a yada 54 e çıkarınca "Run time error 9-out of range" hatası vermekte.. ofis 2007 de sayfa satır sayısı 1048.000 kadar.
Kod a bir ilave yaparak sayfa1 e 500.000 yazdıktan sonra 2. sayfaya..3.sayfaya geçsin istiyorum..bunun için yardımcı olur musunuz..? Teşekkürler.

integer olarak tanımladığınız değişkenleri long olarak tanımlayınız.

 

[gencoglu27]

Sheets("" & sayfa(a)).Range("G:K").ClearContents

sorun var(debug) run time error 9 out of range uyarısı çıktı..!!!=>((

 

[Levent Menteşoğlu]

Aşağıdaki satırın dosyanızda bulunan tüm sayfa adlarını içerdiğinden emin olun.

sayfa = Array("sayfa1", "sayfa2", "sayfa3", "sayfa4", "sayfa5")

 

[gencoglu27]

Tamam Levent arkadaşım.. eline sağlık.. çalıştı..