Çözüldü Redim ve Dictionary hata.(65536 satır sonrası)

FERAZ · 16 Ekim 2018

Merhaba.

Alttaki kod 34464 üncü satıra kadar sayı ekliyor.Sonraki satırlara #YOK hatası ekliyor.
Neden 100000 e kadar eklemediğini öğrenebilir miyim?

Saygılar.

Kod:

Sub x()

    Dim arr()
    Dim i As Long
    [A:A] = Empty
    ReDim arr(1 To 100000)
    Application.Calculation = xlCalculationManual
    
    For i = 1 To 100000
        arr(i) = i
    Next
    
    Range("A1:A" & UBound(arr)).Value = Application.Transpose(arr)

    Application.Calculation = xlCalculationAutomatic
    
    Erase arr
End Sub

FERAZ · 16 Ekim 2018

100000 leri 65536 yapınca normal oldu.Heralde 65536 a göre ayarlı

ÖmerBey · 16 Ekim 2018

Merhaba,
Bu durum transpose limitiyle alakalı. Limit aşıldığı için hata alıyorsunuz.
Alternatif olarak aşağıdaki kodu deneyebilirsiniz. İyi çalışmalar...

Kod:

Sub kod()
With Range("A1:A100000")
    .Formula = "=ROW()"
    .Value = .Value
End With
End Sub

FERAZ · 16 Ekim 2018

Sağolun.

Sadece bir örnekti kod.Dediğiniz gibi limit ile alakalı bencede.Neden 65536 ya kadar buda garip.Redim olayı hızlı olduğu için sormuştum.

Zeki Gürsoy · 16 Ekim 2018

Kullanıcı tanımlı transpose fonksiyonu ile bu sorun aşılabilir...

FERAZ · 16 Ekim 2018

Bir örnek kod yazabilir misiniz Zeki Hocam?

Zeki Gürsoy · 16 Ekim 2018

FERAZ' Alıntı:
Bir örnek kod yazabilir misiniz Zeki Hocam?

Elbette. Ben de şimdi onu deniyordum...

PHP:

Sub x()

    Dim arr()
    Dim i As Long
    [A:A] = Empty
    ReDim arr(1 To 100000)
    Application.Calculation = xlCalculationManual
    
    For i = 1 To 100000
        arr(i) = i
    Next
    
    Range("A1:A" & UBound(arr)).Value = MyTranspose(arr)

    Application.Calculation = xlCalculationAutomatic
    
    Erase arr
End Sub

Function MyTranspose(MyArray)
    Dim vArray()
    
    ReDim vArray(1 To UBound(MyArray), 1 To 1)
    
    Dim L As Long
    
    For L = 1 To UBound(MyArray)
        vArray(L, 1) = MyArray(L)
    Next
    
    MyTranspose = vArray
End Function

halit3 · 16 Ekim 2018

Alternatif olsun

Kod:

Sub test5()
Dim veri(), k As Long
Application.Calculation = xlCalculationManual
k = 100000
ReDim veri(1 To k, 1 To 1)

Application.ScreenUpdating = False
With Range("a1")
For i = 1 To k
veri(i, 1) = i
Next i
.Resize(k, 1).Value = veri
End With
Application.Calculation = xlCalculationAutomatic
MsgBox "işlem tamam"
End Sub

FERAZ · 16 Ekim 2018

Halit ve Zeki hocam elinize sağlık denedim ve süper hızlı çalıştı.

Hayırlı geceler herkese.

Korhan Ayhan · 16 Ekim 2018

Diziyi iki boyutlu tanımladığınızda sorun ortadan kalkıyor.

Benzer bir alternatif.. (1 Milyon satır..)

Kod:

Sub Test()
    Dim arr()
    Dim i As Long
    [A:A] = Empty
    ReDim arr(1 To 1000000, 1 To 1)
    Application.Calculation = xlCalculationManual
    
    For i = 1 To 1000000
        arr(i, 1) = i
    Next
    
    Range("A1:A" & UBound(arr)).Value = arr

    Application.Calculation = xlCalculationAutomatic
    
    Erase arr
End Sub

FERAZ · 16 Ekim 2018

Korhan hocam sağolun.
Yarın deneyebilirim gerçi siz denemişsiniz.
Transpose gereken yerlerde diğerlerini,gerekmeyen yerlerde bunu kullanırım.
Dizi olayı kullanırken hep transpose ile yapıyordum bu şekilde yapma olayını unutmuştum

ÖmerBey · 17 Ekim 2018

Korhan Bey'in 2 boyutlu dizi tavsiyesini görünce bir alternatif de benim aklıma geldi.
Mantık aynı ama yol farklı, deneyiniz...
İyi çalışmalar...

Kod:

Sub kod()
dz = Range("A:A")
For a = LBound(dz) To UBound(dz)
    dz(a, 1) = a
Next
Range("A:A") = dz
End Sub

FERAZ · 17 Ekim 2018

Korhan Ayhan' Alıntı:
Diziyi iki boyutlu tanımladığınızda sorun ortadan kalkıyor.

Benzer bir alternatif.. (1 Milyon satır..)

Kod:

Sub Test() Dim arr() Dim i As Long [A:A] = Empty ReDim arr(1 To 1000000, 1 To 1) Application.Calculation = xlCalculationManual For i = 1 To 1000000 arr(i, 1) = i Next Range("A1:A" & UBound(arr)).Value = arr Application.Calculation = xlCalculationAutomatic Erase arr End Sub

Süper çalıştı.Elinize sağlık.

FERAZ · 17 Ekim 2018

ÖmerBey' Alıntı:
Korhan Bey'in 2 boyutlu dizi tavsiyesini görünce bir alternatif de benim aklıma geldi.
Mantık aynı ama yol farklı, deneyiniz...
İyi çalışmalar...

Kod:

Sub kod() dz = Range("A:A") For a = LBound(dz) To UBound(dz) dz(a, 1) = a Next Range("A:A") = dz End Sub

Kod 1048576 ya kadar 3 saniye sürdü.

Elinize sağlık süper.

FERAZ · 17 Ekim 2018

Daha önce başka bir Foruma sormuştum.Bu konuyu açınca aklıma geldi.Acaba alttaki kod içinde bir çözüm var mıdır?
Dicyionary ile olmalı.

Kod:

Dim i As Long
   
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
   
    Columns(2).Clear
    Columns(3).Clear
    For i = 1 To 70000
        Dict.Add i, i * 10
    Next
    Range("B1").Resize(Dict.Count, 1) = Application.Transpose(Dict.Keys)
    Range("C1").Resize(Dict.Count, 1) = Application.Transpose(Dict.Items)
   
    Set Dict = Nothing

End Sub

ÖmerBey · 17 Ekim 2018

Tekrar merhaba,
Önceki isteğiniz için yukarıda sunduğum çözümlerin son isteğinize uyarlanmış halleri aşağıdadır, inceleyiniz...

Kod:

Sub kod()
Range("B1:B70000").Formula = "=ROW()"
Range("C1:C70000").Formula = "=ROW()*10"
Range("B1:C70000").Value = Range("B1:C70000").Value
End Sub

Kod:

Sub kod1()
dz = Range("B1:C70000")
For i = LBound(dz) To UBound(dz)
    dz(i, 1) = i
    dz(i, 2) = i * 10
Next
Range("B1:C70000") = dz
End Sub

FERAZ · 17 Ekim 2018

Ömer hocam kodlar deneme içindi.Yani Scripting.Dictionary 65536 dan sonrası için olmuyor.

Kodun içinde Scripting.Dictionary olmalı.
Teşekkürler.

Orion1 · 17 Ekim 2018

FERAZ' Alıntı:
Daha önce başka bir Foruma dormuştum.Bu konuyu açınca aklıma geldi.Acaba alttaki kod içinde bir çözüm var mıdır?
Dicyionary ile olmalı.

Kod:

Dim i As Long Dim Dict As Object Set Dict = CreateObject("Scripting.Dictionary") Columns(2).Clear Columns(3).Clear For i = 1 To 70000 Dict.Add i, i * 10 Next Range("B1").Resize(Dict.Count, 1) = Application.Transpose(Dict.Keys) Range("C1").Resize(Dict.Count, 1) = Application.Transpose(Dict.Items) Set Dict = Nothing End Sub

buyurun.

Kod:

Sub myscripting59()
    Dim i As Long, myarr()
    
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    ReDim myarr(1 To 70000, 1 To 2)
    Columns(2).Clear
    Columns(3).Clear
    For i = 1 To 70000
        Dict.Add i, i * 10
        myarr(i, 1) = i
        myarr(i, 2) = i * 10
    Next
    Range("B1").Resize(Dict.Count, 2) = myarr
    Set Dict = Nothing
    Erase myarr

End Sub

FERAZ · 17 Ekim 2018

Sağolunuz Orion1 hocam.Sorun çözüldü sayenizde

Orion1 · 17 Ekim 2018

FERAZ' Alıntı:
Sağolunuz Orion1 hocam.Sorun çözüldü sayenizde

Rica ederim.
İyi çalışmalar.

Çözüldü Redim ve Dictionary hata.(65536 satır sonrası)

FERAZ

FERAZ

ÖmerBey

Destek Ekibi

FERAZ

Zeki Gürsoy

Uzman

FERAZ

Zeki Gürsoy

Uzman

halit3

Uzman

FERAZ

Korhan Ayhan

Administrator

FERAZ

ÖmerBey

Destek Ekibi

FERAZ

FERAZ

FERAZ

ÖmerBey

Destek Ekibi

FERAZ

Orion1

Uzman

FERAZ

Orion1

Uzman