Code Báo Lỗi Out of memory , Khi 37 cột 900.000 dòng

[quochuy2022]

Chào mọi người. Nếu Trường hợp dữ liệu nhiều cụ thể file của mình 37 cột, 900k dòng. Thì phải dùng code như thế nào để không báo đầy bộ nhớ. Xin cảm ơn

Sub TESTCODE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Col As Long
sArr = Range("C5:AM900000").Value2
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 3)
For I = 1 To R
    If sArr(I, 1) <> "" Then
        K = K + 1
        For Col = 1 To 37
            dArr(K, Col) = sArr(I, Col)
        Next Col
    End If
Next I
[AO5].Resize(K, 37) = dArr
End Sub

 

[anhtuan2939]

Chào mọi người. Nếu Trường hợp dữ liệu nhiều cụ thể file của mình 37 cột, 900k dòng. Thì phải dùng code như thế nào để không báo đầy bộ nhớ. Xin cảm ơn

Sub TESTCODE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Col As Long
sArr = Range("C5:AM900000").Value2
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 3)
For I = 1 To R
    If sArr(I, 1) <> "" Then
        K = K + 1
        For Col = 1 To 37
            dArr(K, Col) = sArr(I, Col)
        Next Col
    End If
Next I
[AO5].Resize(K, 37) = dArr
End Sub

View attachment 283862

Lỗi chỗ này bạn nhé, bạn đặt số cho mảng dArr là 3, nhưng kết quả thì đến 37 cột

Bài đã được tự động gộp: 25/11/22

Chào mọi người

Bài này thì bạn nghiên cứu dùng AdvancedFilter, nhanh hơn và code gọn hơn.

 

[quochuy2022]

Lỗi chỗ này bạn nhé, bạn đặt số cho mảng dArr là 3, nhưng kết quả thì đến 37 cột
View attachment 283863

Bài đã được tự động gộp: 25/11/22

Bài này thì bạn nghiên cứu dùng AdvancedFilter, nhanh hơn và code gọn hơn.

bạn có thể chỉ giúp code AdvancedFilter này mình thử nghiên cứu xem

 

[BuiQuangThuan]

bạn có thể chỉ giúp code AdvancedFilter này mình thử nghiên cứu xem

Bạn muốn nghiên cứu thì phải đính kèm file lên chứ không biết mặt mũi file mà viết thế nào

 

[quochuy2022]

Bạn muốn nghiên cứu thì phải đính kèm file lên chứ không biết mặt mũi file mà viết thế nào

Gửi bạn FIle Giả Lập

 

[huhumalu]

Sub TESTCODE222()
Set sArr = Range("C5:AM900000")
Set sKey = Range("AO5").Resize(1, sArr.Columns.Count)
    sKey.Cells(1, 1) = "<>"
        sArr.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=sKey
        Set dArr = sArr.SpecialCells(xlCellTypeVisible)
        dArr.Copy [AO5]

Chưa coi file nữa. Thử đoán mò 1 bữa

 

[ptm0412]

Lỗi chỗ này bạn nhé, bạn đặt số cho mảng dArr là 3, nhưng kết quả thì đến 37 cột

Lỗi Out of meory thì chưa vào được đến đó. Lỗi ngay dòng code đầu tiên (sau Dim)

 

[snow25]

Lỗi Out of meory thì chưa vào được đến đó. Lỗi ngay dòng code đầu tiên (sau Dim)

Hình như cái này phải nâng cấp thêm Ram mà chạy.

 

[CHAOQUAY]

Chào mọi người. Nếu Trường hợp dữ liệu nhiều cụ thể file của mình 37 cột, 900k dòng. Thì phải dùng code như thế nào để không báo đầy bộ nhớ. Xin cảm ơn

Sub TESTCODE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Col As Long
sArr = Range("C5:AM900000").Value2
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 3)
For I = 1 To R
    If sArr(I, 1) <> "" Then
        K = K + 1
        For Col = 1 To 37
            dArr(K, Col) = sArr(I, Col)
        Next Col
    End If
Next I
[AO5].Resize(K, 37) = dArr
End Sub

View attachment 283862

Test lại xem sao

Sub A_TESTCODE()
Dim sArr(), tmp() As Long, dArr()
Dim rws As Long
Dim I As Long, J As Long, K As Long, R As Long, Col As Long

sArr = Range("C5:C900000").Value2
R = UBound(sArr)
ReDim tmp(1 To R)

ReDim dArr(1 To R, 1 To 37)
For I = 1 To R
    If sArr(I, 1) <> "" Then
        rws = rws + 1
        tmp(rws) = I
        dArr(rws, 1) = sArr(I, 1)
    End If
Next I

For J = 1 To 36
    sArr = Range("C5:C900000").Offset(, J)
    For I = 1 To rws
        K = tmp(I)
        dArr(I, J + 1) = sArr(K, J + 1)
    Next I
Next J

[AO5].Resize(K, 37) = dArr
End Sub

 

[quochuy2022]

Test lại xem sao

Sub A_TESTCODE()
Dim sArr(), tmp() As Long, dArr()
Dim rws As Long
Dim I As Long, J As Long, K As Long, R As Long, Col As Long

sArr = Range("C5:C900000").Value2
R = UBound(sArr)
ReDim tmp(1 To R)

ReDim dArr(1 To R, 1 To 37)
For I = 1 To R
    If sArr(I, 1) <> "" Then
        rws = rws + 1
        tmp(rws) = I
        dArr(rws, 1) = sArr(I, 1)
    End If
Next I

For J = 1 To 36
    sArr = Range("C5:C900000").Offset(, J)
    For I = 1 To rws
        K = tmp(I)
        dArr(I, J + 1) = sArr(K, J + 1)
    Next I
Next J

[AO5].Resize(K, 37) = dArr
End Sub

Nó báo lỗi ngày dòng này bạn ơi .

 

[CHAOQUAY]

Nó báo lỗi ngày dòng này bạn ơi .

View attachment 283902

Sửa dòng trên thành dòng dưới chắc là chạy được

dArr(I, J + 1) = sArr(K, J + 1)
dArr(I, J + 1) = sArr(K, 1)