VBA Macro treo sau 32000 hàng

Question

Tôi có macro VBA sao chép hàng từ một trang tính sang bảng tính khác dựa trên việc tìm giá trị trong ô trong 3 cột. Macro hoạt động nhưng gặp sự cố khi nó đạt đến hàng 32767. Không có công thức hoặc định dạng đặc biệt nào trong hàng này. Hơn nữa, tôi đã lấy hàng đó ra, nhưng nó vẫn treo trên số hàng đó. Đây có phải là một hạn chế trong excel? Có một số 43000 trong bảng tính được là quá trình

Vì vậy, tôi yêu cầu những gì là sai với vĩ mô của tôi và làm thế nào tôi có thể lấy nó đến cuối của bảng tính:

Dim LSearchRow As Integer 
Dim LCopyToRow As Integer 
Dim wks As Worksheet 
On Error GoTo Err_Execute 

Đối Mỗi wks Trong Worksheets

LSearchRow = 4 
LCopyToRow = 4 

ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count) 
Set wksCopyTo = ActiveSheet 
wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3) 

While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0 

    If wks.Range("AB" & CStr(LSearchRow)).Value = "Yes" And wks.Range("AK" & CStr(LSearchRow)).Value = "Yes" And wks.Range("BB" & CStr(LSearchRow)).Value = "Y" Then 

     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 
     Selection.Copy 


     wksCopyTo.Select 
     wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select 
     wksCopyTo.Paste 

     'Move counter to next row 
     LCopyToRow = LCopyToRow + 1 
     'Go back to Sheet1 to continue searching 
     wks.Select 
    End If 
    LSearchRow = LSearchRow + 1 
Wend 

Application.CutCopyMode = False 
Range("A3").Select 
MsgBox "All matching data has been copied." 
Next wks 
    Exit Sub 
Err_Execute: 
    MsgBox "An error occurred." 

Xin vui lòng trợ giúp!

Answer 1

Loại VBA 'Int' là trường 16 bit được ký để nó chỉ có thể giữ giá trị từ -32768 đến +32767. Thay đổi các biến đó thành 'Long', là trường 32 bit có dấu và có thể chứa các giá trị từ -2147483648 đến +2147483647. Nên đủ cho Excel. ;)

Answer 2

này nghe có vẻ như một vấn đề nguyên

Các Integer và các kiểu dữ liệu dài cả hai có thể giữ tích cực hay tiêu cực giá trị. Sự khác biệt giữa chúng là kích thước của chúng: Biến số nguyên có thể giữ giá trị giữa -32,768 và 32,767, trong khi biến Long có thể dao động từ -2,147,483,648 đến 2,147,483,647.

Nhưng bạn đang sử dụng phiên bản nào? Bởi vì:

Người lập trình đã sử dụng số nguyên để giữ số nhỏ vì chúng yêu cầu ít bộ nhớ hơn. Trong các phiên bản gần đây, tuy nhiên, VBA chuyển đổi tất cả các giá trị số nguyên để nhập Dài, ngay cả khi chúng được khai báo là loại Số nguyên. Do đó, không còn lợi thế hiệu suất là sử dụng biến số nguyên; trên thực tế, các biến Long có thể hơi nhanh hơn vì VBA không phải chuyển đổi chúng.

Thông tin này là trực tiếp từ MSDN

CẬP NHẬT

Xin cũng đọc những nhận xét đầu tiên! Tôi đã diễn giải thông tin MSDN một cách sai lầm!

Thats MSDN gây hiểu lầm: VBA không tự chuyển đổi số nguyên thành Dài. Dưới bìa CPU chuyển đổi số nguyên thành dài, thực hiện số học và sau đó chuyển đổi kết quả trở lại thành số nguyên dài. Vì vậy, VBA số nguyên vẫn không thể giữ số lớn hơn 32K - Charles Williams

Answer 3

Bạn có thể tránh được những Integer vs vấn đề dài bằng cách sử dụng lệnh For Each hơn incrementing hàng. Đối với mỗi thường nhanh hơn, cũng như tránh Chọn phạm vi.Dưới đây là ví dụ:

Sub CopySheets() 

    Dim shSource As Worksheet 
    Dim shDest As Worksheet 
    Dim rCell As Range 
    Dim aSheets() As Worksheet 
    Dim lShtCnt As Long 
    Dim i As Long 

    Const sDESTPREFIX As String = "dest_" 

    On Error GoTo Err_Execute 

    For Each shSource In ThisWorkbook.Worksheets 
     lShtCnt = lShtCnt + 1 
     ReDim Preserve aSheets(1 To lShtCnt) 
     Set aSheets(lShtCnt) = shSource 
    Next shSource 

    For i = LBound(aSheets) To UBound(aSheets) 
     Set shSource = aSheets(i) 

     'Add a new sheet 
     With ThisWorkbook 
      Set shDest = .Worksheets.Add(, .Worksheets(.Worksheets.Count)) 
      shDest.Name = sDESTPREFIX & shSource.Name 
     End With 

     'copy header row 
     shSource.Rows(3).Copy shDest.Rows(3) 

     'loop through the cells in column a 
     For Each rCell In shSource.Range("A4", shSource.Cells(shSource.Rows.Count, 1).End(xlUp)).Cells 
      If Not IsEmpty(rCell.Value) And _ 
       rCell.Offset(0, 27).Value = "Yes" And _ 
       rCell.Offset(0, 36).Value = "Yes" And _ 
       rCell.Offset(0, 53).Value = "Yes" Then 

       'copy the row 
       rCell.EntireRow.Copy shDest.Range(rCell.Address).EntireRow 
      End If 
     Next rCell 
    Next i 

    MsgBox "All matching data has been copied." 

Err_Exit: 
    'do this stuff even if an error occurs 
    On Error Resume Next 
    Application.CutCopyMode = False 
    Exit Sub 

Err_Execute: 
    MsgBox "An error occurred." 
    Resume Err_Exit 

End Sub