Số dòng quá lớn trong VBA

duynhatgpe · 23/6/20

Thân chào GPE !

Mình đang cần tìm hiểu làm cách nào chay. For…net trên số dòng mặc định của excel là 1048576 , ở trên “sobai1” chạy không đươc vì tới 4 dòng quá số dòng của excel, còn “so bai2” chay được vì chỉ có 3 dòng sô mà thôi

Các huynh đệ hãy giúp mình chạy được 4 dòng số qua 2 côt hay 2 sheet cũng được , bằng VBA nào cũng được , xin thành thật cảm ơn ,chúc huynh đệ luôn mạnh khỏe và hạnh phúc !

tigertiger · 23/6/20

duynhatgpe đã viết:
Thân chào GPE !

Mình đang cần tìm hiểu làm cách nào chay. For…net trên số dòng mặc định của excel là 1048576 , ở trên “sobai1” chạy không đươc vì tới 4 dòng quá số dòng của excel, còn “so bai2” chay được vì chỉ có 3 dòng sô mà thôi

Các huynh đệ hãy giúp mình chạy được 4 dòng số qua 2 côt hay 2 sheet cũng được , bằng VBA nào cũng được , xin thành thật cảm ơn ,chúc huynh đệ luôn mạnh khỏe và hạnh phúc !

Chắc các Huynh đệ còn mải bế quan, chuẩn bị cho cuộc mãi võ ở 3 miền

vu_tuan_manh_linh · 23/6/20

Chả hiểu code bạn dùng vào việc gì, nhưng để "chạy được" đến dòng cuối cùng thì thêm nếm một tý là được:

PHP:

Sub sobai1()
 Dim Arr(), vlArr(1 To 1048576, 1 To 9), i, j, k, h, g, LR, x, mid$, n
   Arr1 = [A1].Value
   Arr2 = [A2].Value
   Arr3 = [A3].Value
   Arr4 = [A4].Value
  n = 0
     For i = 1 To Len(Arr1)
      For j = 1 To Len(Arr2)
      For k = 1 To Len(Arr3)
       For l = 1 To Len(Arr4)
        n = n + 1
        If n <= 1048567 Then
            vlArr(n, 1) = Mid$(Arr1, i, 1) & Mid$(Arr2, j, 1) & Mid$(Arr3, k, 1) & Mid$(Arr4, l, 1)
        Else
            GoTo tiep
        End If
       Next
      Next
     Next
    Next
tiep:
n = n - 1
[A9:A1048576].ClearContents
[A9].Resize(n, 1) = vlArr
 
End Sub

ptm0412 · 23/6/20

Số phần tử thu được là 59^4 = 12,117,361 (12 triệu) làm sao 2 cột mà đủ.
Nếu mỗi cột lấy tròn 1,000,000 phần tử (dòng) thì số cột sẽ là 13, mỗi cột lấy tròn 500,000 phần tử (dòng) thì số cột sẽ là 25
Code sau chia 500,000 dòng và 25 cột (cột 25 chứa ít hơn), chạy 40 giây

PHP:

Sub sobai()
 Dim Arr(), vlArr(1 To 500000, 1 To 25), i, j, k, h, g, LR, x, mid$
   Arr1 = [A1].Value
   Arr2 = [A2].Value
   Arr3 = [A3].Value
   Arr4 = [A4].Value
   t = Timer
  n = 0: m = 1
     For i = 1 To Len(Arr1)
      For j = 1 To Len(Arr2)
      For k = 1 To Len(Arr3)
       For l = 1 To Len(Arr4)
      
       n = n + 1
       If n > 500000 Then m = m + 1: n = 1
       vlArr(n, m) = Mid$(Arr1, i, 1) & Mid$(Arr2, j, 1) & Mid$(Arr3, k, 1) & Mid$(Arr4, l, 1)
          
       Next
      Next
     Next
    Next
    
    [A9:A1048576].ClearContents
    [A9].Resize(500000, 25) = vlArr
     [F1].Value = Timer - t
End Sub

HieuCD · 23/6/20

duynhatgpe đã viết:
Thân chào GPE !

Mình đang cần tìm hiểu làm cách nào chay. For…net trên số dòng mặc định của excel là 1048576 , ở trên “sobai1” chạy không đươc vì tới 4 dòng quá số dòng của excel, còn “so bai2” chay được vì chỉ có 3 dòng sô mà thôi

Các huynh đệ hãy giúp mình chạy được 4 dòng số qua 2 côt hay 2 sheet cũng được , bằng VBA nào cũng được , xin thành thật cảm ơn ,chúc huynh đệ luôn mạnh khỏe và hạnh phúc !

Code chạy khá nhanh, có thể tăng tốc thêm nhưng có thể bạn khó hiểu

Mã:

Sub ABC()
  Dim Res(), str$, str2$, str3$, str4$, chr$, chr2$, chr3$
  Dim i&, i2&, i3&, i4&, n&, n2&, n3&, n4&, k&, j&, sCol&, sRow&
 
  str = [A1].Value:    str2 = [A2].Value
  str3 = [A3].Value:   str4 = [A4].Value
  n = Len(str):        n2 = Len(str2)
  n3 = Len(str3):      n4 = Len(str4)
 
  sRow = 1000000 'Ket qua 1000000 dong
  sCol = (n * n2 * n3 * n4 - 1) \ sRow + 1
  ReDim Res(1 To sRow, 1 To sCol)
 
  j = 1
  For i = 1 To n
    chr = Mid$(str, i, 1)
      For i2 = 1 To n2
        chr2 = Mid$(str2, i2, 1)
        For i3 = 1 To n3
          chr3 = Mid$(str3, i3, 1)
          For i4 = 1 To n4
            If k < sRow Then
              k = k + 1
            Else
              k = 1:  j = j + 1
            End If
            Res(k, j) = chr & chr2 & chr3 & Mid$(str4, i4, 1)
          Next
        Next
      Next
  Next
  Sheet1.UsedRange.Offset(5).ClearContents
  [A9].Resize(sRow, sCol) = Res
 
End Sub

duynhatgpe · 26/6/20

ptm0412 đã viết:
Số phần tử thu được là 59^4 = 12,117,361 (12 triệu) làm sao 2 cột mà đủ.
Nếu mỗi cột lấy tròn 1,000,000 phần tử (dòng) thì số cột sẽ là 13, mỗi cột lấy tròn 500,000 phần tử (dòng) thì số cột sẽ là 25
Code sau chia 500,000 dòng và 25 cột (cột 25 chứa ít hơn), chạy 40 giây

PHP:

Sub sobai() Dim Arr(), vlArr(1 To 500000, 1 To 25), i, j, k, h, g, LR, x, mid$ Arr1 = [A1].Value Arr2 = [A2].Value Arr3 = [A3].Value Arr4 = [A4].Value t = Timer n = 0: m = 1 For i = 1 To Len(Arr1) For j = 1 To Len(Arr2) For k = 1 To Len(Arr3) For l = 1 To Len(Arr4) n = n + 1 If n > 500000 Then m = m + 1: n = 1 vlArr(n, m) = Mid$(Arr1, i, 1) & Mid$(Arr2, j, 1) & Mid$(Arr3, k, 1) & Mid$(Arr4, l, 1) Next Next Next Next [A9:A1048576].ClearContents [A9].Resize(500000, 25) = vlArr [F1].Value = Timer - t End Sub

Chân thành cám ơn !
Cho em hỏi thêm trong bài này nêu mình muốn các dòng số chạy theo từ cột A của từng sheet1, sheet2,sheet3......thì cần viết code gì thêm .dưới đây là bài em đã áp dụng bài trên

ptm0412 · 26/6/20

duynhatgpe đã viết:
Chân thành cám ơn !
Cho em hỏi thêm trong bài này nêu mình muốn các dòng số chạy theo từ cột A của từng sheet1, sheet2,sheet3......thì cần viết code gì thêm .dưới đây là bài em đã áp dụng bài trên

79^4 = 38,950,081 mà bạn code 25 cột làm sao cho đủ?

ptm0412 · 26/6/20

Tôi xem lại, kết quả chỉ có 1,749,060 phần tử (chưa nhớ ra cách tính)
Chia bao nhiêu sheet thì mảng kết quả chia bấy nhiêu cột. Code dưới đây chạy 10 giây.
Ghi chú: Sao lại khai báo hàm Mid, khai báo 1 số biến mà không dùng.

PHP:

Sub sobai1()

Dim vlArr(), i, j, k, h, n, m, XVal1, XVal2, XVal3, XVal4
Dim ElementCount, RwsCount, ColsCount
t = Timer
   XVal1 = [A1].Value:   XVal2 = [A2].Value
   XVal3 = [A3].Value:   XVal4 = [A4].Value
ElementCount = 1749060 'Len(XVal1) * Len(XVal2) * Len(XVal3) * Len(XVal4)'
ColsCount = 7
RwsCount = ElementCount \ ColsCount + 1
ReDim vlArr(1 To RwsCount, 1 To ColsCount)
  n = 0: m = 1
  For i = 1 To Len(XVal1)
      For j = i To Len(XVal2)
          For k = j To Len(XVal3)
              For h = k To Len(XVal4)
                  n = n + 1
                  If n > RwsCount Then m = m + 1: n = 1
                  vlArr(n, m) = Mid$(XVal1, i, 1) & Mid$(XVal2, j, 1) & Mid$(XVal3, k, 1) & Mid$(XVal4, h, 1)
              Next
          Next
      Next
  Next
Application.ScreenUpdating = False
    Sheet1.[A9].Resize(RwsCount, ColsCount).ClearContents
    Sheet1.[A9].Resize(RwsCount, ColsCount) = vlArr
    For i = 2 To ColsCount
        Sheets("Sheet" & i).[A9].Resize(RwsCount, 1).ClearContents
        Sheet1.Cells(9, i).Resize(RwsCount, 1).Cut Sheets("Sheet" & i).[A9]
    Next
Application.ScreenUpdating = True
[F1] = Timer - t
End Sub

duynhatgpe · 27/6/20

ptm0412 đã viết:

Tôi xem lại, kết quả chỉ có 1,749,060 phần tử (chưa nhớ ra cách tính)
Chia bao nhiêu sheet thì mảng kết quả chia bấy nhiêu cột. Code dưới đây chạy 10 giây.
Ghi chú: Sao lại khai báo hàm Mid, khai báo 1 số biến mà không dùng.

PHP:

Sub sobai1()

Dim vlArr(), i, j, k, h, n, m, XVal1, XVal2, XVal3, XVal4
Dim ElementCount, RwsCount, ColsCount
t = Timer
   XVal1 = [A1].Value:   XVal2 = [A2].Value
   XVal3 = [A3].Value:   XVal4 = [A4].Value
ElementCount = 1749060 'Len(XVal1) * Len(XVal2) * Len(XVal3) * Len(XVal4)'
ColsCount = 7
RwsCount = ElementCount \ ColsCount + 1
ReDim vlArr(1 To RwsCount, 1 To ColsCount)
  n = 0: m = 1
  For i = 1 To Len(XVal1)
      For j = i To Len(XVal2)
          For k = j To Len(XVal3)
              For h = k To Len(XVal4)
                  n = n + 1
                  If n > RwsCount Then m = m + 1: n = 1
                  vlArr(n, m) = Mid$(XVal1, i, 1) & Mid$(XVal2, j, 1) & Mid$(XVal3, k, 1) & Mid$(XVal4, h, 1)
              Next
          Next
      Next
  Next
Application.ScreenUpdating = False
    Sheet1.[A9].Resize(RwsCount, ColsCount).ClearContents
    Sheet1.[A9].Resize(RwsCount, ColsCount) = vlArr
    For i = 2 To ColsCount
        Sheets("Sheet" & i).[A9].Resize(RwsCount, 1).ClearContents
        Sheet1.Cells(9, i).Resize(RwsCount, 1).Cut Sheets("Sheet" & i).[A9]
    Next
Application.ScreenUpdating = True
[F1] = Timer - t
End Sub

Thành thật cám ơn !
Đúng như ý em đang thực tập viết code VBA
Chúc luôn vui vẽ , sức khỏe dồi dào và gặp nhiều may mắn !

ptm0412 · 27/6/20

duynhatgpe đã viết:
Đúng như ý em đang thực tập viết code VBA

Bạn nên chia sẻ cách tính ra số lượng phần tử kết quả (trong bài trên là 1,749,060), ngay cả tôi cũng quên rồi. Con số này cần công thức tính toán để đưa vào code trường hợp tổng quát cho người khác có thể áp dụng

VetMini · 27/6/20

Mình tính hỏi mấy chục triệu dữ liệu dùng làm cái gì. Té ra là chỉ tập viết code.
Tập mà chọn đề bài bắt ớn.
Kiểu học này là kiểu "ăn cả ngã không". Một là trong vòng 3 tháng thành siêu VBA. Hai là 3 năm chưa nắm được lý thuyết mảng.

Số dòng quá lớn trong VBA

duynhatgpe

Thành viên mới

File đính kèm

tigertiger

Coming back ...

vu_tuan_manh_linh

linhvtm84@gmail.com

ptm0412

Bad Excel Member

HieuCD

Chuyên gia GPE

duynhatgpe

Thành viên mới

File đính kèm

ptm0412

Bad Excel Member

ptm0412

Bad Excel Member

duynhatgpe

Thành viên mới

ptm0412

Bad Excel Member

VetMini

Ăn cùng góc phố

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng