Sửa lỗi Runtime error "6" Over flow (3 người xem)

[vanle33]

Tôi có file Nhật ký này nhưng khi nhấn Cap Nhat thì bị lỗi Runtime error "6" Over Flow. Mong các thành viên trợ giúp sửa lỗi trên cho tôi.

Do tôi không phải chủ nhân của file này nên không có pass VBA mà phải dùng Remove VBA ... của bác siwtom.

 

[langtuchungtinh360]

Tui sẽ gợi ý cách sửa code #58
Bổ xung cái này vào sau chữ loop
For i= 1 to k-1
A= dArr(k,2)
B= dArr(k+1,2)
If A<>"" then Tam= A
If B= Tam then dArr(k+1,2)=""
Next i

 

[SA_DQ]

Xin góp í nhỏ với Langtuchungtinh360;688648

. . . .
Thứ 1: Muốn được giúp gì thì 1 là đưa dữ liệu mẫu gần giống nhất với file thật (nếu file có tính bảo mật)
Thứ 2: trình bày kết quả mong muốn có được
Thứ 3: trình bày cách làm thế nào ra kết quả đó

Theo kinh nghiệm của mình, file giả lập hay/rất hay sẽ là file có đủ các fương án sẩy ra; Chuyện này khác với file có trong thực tế đang sử dụng.

Ví dụ bảng chấm công (BCC) của CQ; ta muốn tổng hợp thì fải có trên nớ tất thẩy các loại công đã qui định của CQ đó; chứ không fải là 1 BCC thực của 1 tháng nào đó trong CQ dù BCC đó có là 31 ngày đi chăng nữa.

 

[vanle33]

to langtuchungtinh:
Không phải quét chữ mà tôi nói ở #81 và #1 là có pass VBA đâu. Thế là bạn không biết bác siwtom và các độc chiêu của bác ý rồi. Có chạy code của bác siwtom cũng không ra pass VBA đâu.

 

[langtuchungtinh360]

to langtuchungtinh:
Không phải quét chữ mà tôi nói ở #81 và #1 là có pass VBA đâu. Thế là bạn không biết bác siwtom và các độc chiêu của bác ý rồi. Có chạy code của bác siwtom cũng không ra pass VBA đâu.

Vậy cái phần t bổ xung đó đúng yêu cầu chưa

 

[vanle33]

Tui sẽ gợi ý cách sửa code #58
Bổ xung cái này vào sau chữ loop
For i= 1 to k-1
A= dArr(k,2)
B= dArr(k+1,2)
If A<>"" then Tam= A
If B= Tam then dArr(k+1,2)=""
Next i

Sau khi tôi bổ sung rồi chạy code thì ra cái này

 

[langtuchungtinh360]

Sau khi tôi bổ sung rồi chạy code thì ra cái này

lấy cái này dán vô thay thế nha

Public Sub helloHamDuyet()
Dim r As Long, k As Long, dArr(1 To 65000, 1 To 4), arr
Dim startDate As Date, endDate As Date, ub As Long, h As Boolean
arr = Sheet1.Range("A17:K" & Sheet1.[A65000].End(xlUp).Row).Value
ub = UBound(arr)
startDate = Sheet5.[F5].Value
endDate = Sheet5.[F6].Value
With Sheet4
    .Range("A14:D" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).ClearContents
    k = 1
    Do While WorksheetFunction.RoundDown(startDate, 0) <= _
             WorksheetFunction.RoundDown(endDate, 0)
        r = 1: h = False
        dArr(k, 1) = k
        dArr(k, 2) = startDate
        dArr(k, 4) = "Mua Công truong nghi"
        Do While arr(r, 1) <> arr(ub, 1)
            If arr(r, 11) = startDate Then
                dArr(k, 1) = k
                dArr(k, 2) = startDate
                dArr(k, 3) = arr(r, 2)
                dArr(k, 4) = "Nghiêm thu " & arr(r, 3)
                k = k + 1: h = True
            End If
            If arr(r, 6) <= startDate And arr(r, 7) >= startDate Then
                dArr(k, 1) = k


                dArr(k, 2) = startDate


                dArr(k, 3) = arr(r, 2)
                dArr(k, 4) = "Thi công " & arr(r, 3)
                k = k + 1: h = True
            End If
            r = r + 1
        Loop
        startDate = startDate + 1
        If Not h Then k = k + 1
    Loop
    
[COLOR=#ff0000]Dim l, Tren, Duoi As Long
l = 1
For i = 1 To k - 1
Tren = dArr(i, 2)
Duoi = dArr(i + 1, 2)
If Tren <> "" Then Tam = Tren
If Tam = Duoi Then
dArr(i + 1, 2) = ""
End If
If dArr(i, 2) <> "" Then
dArr(i, 1) = l
l = l + 1
Else
dArr(i, 1) = ""
End If
Next i[/COLOR]


    .Range("A14:D14").Resize(k).Value = dArr
End With
End Sub

nếu có phát sinh hay không được nữa bác tự xử đi nha. (làm xong cái này lại lòi cái kia)

 

[vanle33]

Các bạn chỉnh giúp tôi code dưới đây để khi xuất kết quả tại Sheet Nhật ký thì nếu có 1 công việc vừa có Thi công ... và Nghiệm thu ... trong 1 ngày thì dòng Thi công ... sẽ được ở trên dòng Nghiệm thu ... công việc đó. (Hiện tại Kết quả xuất ra thì dòng Nghiệm thu ... lại ở trên dòng Thi công ...)
Public Sub hello1HamDuyet()
Dim r As Long, k As Long, dArr(1 To 65000, 1 To 4), arr
Dim startDate As Date, endDate As Date, ub As Long, h As Boolean
arr = Sheet1.Range("A17:K" & Sheet1.[A65000].End(xlUp).Row).Value
ub = UBound(arr)
startDate = Sheet5.[F5].Value
endDate = Sheet5.[F6].Value
With Sheet4
.Range("A14" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).ClearContents
k = 1
Do While WorksheetFunction.RoundDown(startDate, 0) <= _
WorksheetFunction.RoundDown(endDate, 0)
r = 1: h = False
dArr(k, 1) = k
dArr(k, 2) = startDate
dArr(k, 4) = " " 'Da xoa chu Mua cong truong nghi
Do While arr(r, 1) <> arr(ub, 1)
If arr(r, 11) = startDate Then
dArr(k, 1) = k
dArr(k, 2) = startDate
dArr(k, 3) = arr(r, 2)
dArr(k, 4) = "Nghiêm thu " & arr(r, 3)
k = k + 1: h = True
End If
If arr(r, 6) <= startDate And arr(r, 7) >= startDate Then
dArr(k, 1) = k
dArr(k, 2) = startDate
dArr(k, 3) = arr(r, 2)
dArr(k, 4) = "Thi công " & arr(r, 3)
k = k + 1: h = True
End If
r = r + 1
Loop
startDate = startDate + 1
If Not h Then k = k + 1
Loop
.Range("A1414").Resize(k).Value = dArr
End With
End Sub
Xin cảm ơn!

 

[ChanhTQ@]

Không có file thì cũng khó mà giải quyết được vấn đề;
Nhưng mình đoán là liên quan đến 2 khổ lệnh này:

    Do While Arr(R, 1) <> Arr(uB, 1)
1       If Arr(R, 11) = startDate Then
            dArr(K, 1) = K:         dArr(K, 2) = startDate
            dArr(K, 3) = Arr(R, 2): dArr(K, 4) = "Nghiêm thu " & Arr(R, 3)
            K = K + 1:              H = True
        End If
            
2       If Arr(R, 6) <= startDate And Arr(R, 7) >= startDate Then
            dArr(K, 1) = K:         dArr(K, 2) = startDate
            dArr(K, 3) = Arr(R, 2): dArr(K, 4) = "Thi công " & Arr(R, 3)
            K = K + 1:              H = True
        End If
        R = R + 1
   Loop

Nhưng chưa rõ là cột/trường chứa các từ 'Nghiệm thu' hay 'Thi công' nằm ở nơi mô?
Nến đành chờ file hay bạn nói rõ hơn!

 

[vanle33]

Không có file thì cũng khó mà giải quyết được vấn đề;
Nhưng mình đoán là liên quan đến 2 khổ lệnh này:

    Do While Arr(R, 1) <> Arr(uB, 1)
1       If Arr(R, 11) = startDate Then
            dArr(K, 1) = K:         dArr(K, 2) = startDate
            dArr(K, 3) = Arr(R, 2): dArr(K, 4) = "Nghiêm thu " & Arr(R, 3)
            K = K + 1:              H = True
        End If
            
2       If Arr(R, 6) <= startDate And Arr(R, 7) >= startDate Then
            dArr(K, 1) = K:         dArr(K, 2) = startDate
            dArr(K, 3) = Arr(R, 2): dArr(K, 4) = "Thi công " & Arr(R, 3)
            K = K + 1:              H = True
        End If
        R = R + 1
   Loop

Nhưng chưa rõ là cột/trường chứa các từ 'Nghiệm thu' hay 'Thi công' nằm ở nơi mô?
Nến đành chờ file hay bạn nói rõ hơn!

Đúng là 2 chỗ trên đó bác. Em không hiểu code nên không cut dán đổi vị trí 2 đoạn code trên được.
File thì bác xem file đính kèm. Bác chèn code ở #89 vào là chạy được.

 

[ChanhTQ@]

File thì bác xem file đính kèm. Bác chèn code ở #89 vào là chạy được.

Có cắt dán VBA gì được đâu?, Nó đâu cho fép làm điều đó!
Với lại file chỉ có 2 trang tính; Nhưng ở 2 trang này không có những từ như bạn đề cập.

 

[vanle33]

Có cắt dán VBA gì được đâu?, Nó đâu cho fép làm điều đó!
Với lại file chỉ có 2 trang tính; Nhưng ở 2 trang này không có những từ như bạn đề cập.

Dữ liệu đầu vào thì ở bên Sheet Danh mục (có thể gồm 1 vài trang hoặc 1 vài chục trang), dữ liệu được xuất ra tại Sheet Nhật ký bác ạ. Bác tạo 1 nút bấm và gán code ở #89 vào là chạy được. Nhưng chưa đúng yêu cầu như em đã nói ở #89.
Em không hiểu nút LÊ VĂN em tạo lại không chạy được code, hihì.

 

[giangleloi]

Dữ liệu đầu vào thì ở bên Sheet Danh mục (có thể gồm 1 vài trang hoặc 1 vài chục trang), dữ liệu được xuất ra tại Sheet Nhật ký bác ạ. Bác tạo 1 nút bấm và gán code ở #89 vào là chạy được. Nhưng chưa đúng yêu cầu như em đã nói ở #89.
Em không hiểu nút LÊ VĂN em tạo lại không chạy được code, hihì.

Code #89 và file gửi lên không có ăn nhập gì với nhau cả. Chạy còn không được huống chi là "Chạy không đúng yêu cầu".

 

[vanle33]

Code #89 và file gửi lên không có ăn nhập gì với nhau cả. Chạy còn không được huống chi là "Chạy không đúng yêu cầu".

File này thì chắc chạy được khi nhấn nút vàng. Chắc do tôi xóa mất sheet nên code không chạy được!

 

[quick87]

Nhờ các Cô chú, anh chị vá các bạn sửa giúp em lỗi: Runtime error "6" Over flow như hình và file đính kèm ạ:

File em muốn lấy dữ liệu từ Sheet Data sang Sheet BC có chọn lọc các cột cho sẵn như trong Module.
Modules:

Sub LayDL()
   Dim sArr, dArr, I As Long, k As Long, n As Long, eR As Long
   sArr = Sheets("Data").Range("A4").CurrentRegion.Value
   ReDim dArr(1 To UBound(sArr), 1 To 30)
   Application.ScreenUpdating = False
   For I = 4 To UBound(sArr)
    If sArr(I, 19) <> "" Then
        k = k + 1
        dArr(k, 1) = k
        dArr(k, 1) = sArr(I, 27)
        dArr(k, 2) = sArr(I, 28)
        dArr(k, 3) = sArr(I, 29)
        dArr(k, 4) = sArr(I, 9)
        dArr(k, 5) = "Khach le"
        dArr(k, 6) = ""
        dArr(k, 7) = "Phi dich vu"
        dArr(k, 8) = sArr(I, 21)
        dArr(k, 9) = sArr(I, 19)
        dArr(k, 10) = sArr(I, 22)
        dArr(k, 11) = sArr(I, 30)
        dArr(k, 12) = sArr(I, 7)
        dArr(k, 13) = sArr(I, 5)
     End If
    Next
    Sheet3.Activate
    Range("A2:M" & Range("A" & Rows.Count).End(xlDown).Row).Clear
    If k > 0 Then Range("A2").Resize(k, 17).Value = dArr
    Application.ScreenUpdating = True
 
    For I = 4 To UBound(sArr)
     If sArr(I, 26) <> 0 Then
        n = n + 1
        dArr(n, 1) = n
        dArr(n, 1) = sArr(I, 27)
        dArr(n, 2) = sArr(I, 28)
        dArr(n, 3) = sArr(I, 29)
        dArr(n, 4) = sArr(I, 9)
        dArr(n, 5) = "Khach le"
        dArr(n, 6) = ""
        dArr(n, 7) = "Service Charge"
        dArr(n, 8) = sArr(I, 25)
        dArr(n, 9) = sArr(I, 23)
        dArr(n, 10) = sArr(I, 26)
        dArr(n, 11) = sArr(I, 30)
        dArr(n, 12) = sArr(I, 7)
        dArr(n, 13) = sArr(I, 5)
     End If
    Next
    Sheet3.Activate
    eR = Range("A" & Rows.Count).End(xlUp).Row + 1
    If n > 0 Then Range("A" & eR).Resize(n, 17).Value = dArr
    Application.ScreenUpdating = True
      With Sheet3
            [I:I].Replace What:=" VAT", Replacement:=""
            Sheet3.Activate
            ActiveWindow.DisplayGridlines = False
            [D:D].NumberFormat = "mm/dd/yyyy"
            [H:H,J:J].NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
            eR = Range("A" & Rows.Count).End(xlUp).Row
            [N1] = "Site"
            [N2].Formula = "= M2 & ""_"" & text(month(D2),""0#"")& ""_"" &right(year(D2),2)& ""_"" &Right(A2, 3)"
            Range("N2:N" & eR).FillDown
            With Range("N2:N" & eR)
                .Value = .Value
                [M:M].Delete
                [A1].Select
            End With
        End With
End Sub

Em cảm ơn !