Lỗi application-defined or object-defined error

[Vàng A Súp]

Em xin chào các bác, các anh / chị
File Excel của em có 14 hợp đồng.
Tại Sheet " Phu_Luc_1 " em muốn dò tìm 1 vùng dữ liệu hiện thị tại ô A10 : Q 33 với giá trị dò tìm ở ô C37 ( C37 là số hợp đồng, được tăng lên giảm xuống qua nút ấn ), và vùng dò tìm ở Sheet " Dau_Vao".
Và em có VBA để làm việc đó, nhưng khi chạy lại báo lỗi: application-defined or object-defined error
Em mong nhận được sự giúp đỡ của các bác, anh chị trong diễn đàn. Chúc mọi người có kỳ nghỉ lễ vui vẻ bên gia đình.

Sub ABC()
Dim iR&, DK&, X&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
iR = Sheets("Dau_Vao").Range("C" & Rows.Count).End(3).Row
DK = Sheets("Phu_luc_1").Range("C37").Value
Sheets("Phu_luc_1").Range("A10:Q33").ClearContents
For X = 7 To iR Step 25
If Sheets("Dau_Vao").Range("A" & X).Value = DK Then
Sheets("Dau_Vao").Range("B" & X).Resize(24, 17).Copy
Sheets("Phu_luc_1").Range("A10").PasteSpecial Paste:=xlPasteValues
Exit For
Application.CutCopyMode = False
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[huonglien1901]

Em xin chào các bác, các anh / chị
File Excel của em có 14 hợp đồng.
Tại Sheet " Phu_Luc_1 " em muốn dò tìm 1 vùng dữ liệu hiện thị tại ô A10 : Q 33 với giá trị dò tìm ở ô C37 ( C37 là số hợp đồng, được tăng lên giảm xuống qua nút ấn ), và vùng dò tìm ở Sheet " Dau_Vao".
Và em có VBA để làm việc đó, nhưng khi chạy lại báo lỗi: application-defined or object-defined error
Em mong nhận được sự giúp đỡ của các bác, anh chị trong diễn đàn. Chúc mọi người có kỳ nghỉ lễ vui vẻ bên gia đình.

Sheet nào bạn bảo vệ vậy?
Trong file bạn có sheet 3 đâu:

Sub Spinner4_Change()
Dim Rng As Range
    Sheet9.Unprotect "cc"
    Application.ScreenUpdating = False
    For Each Rng In [A39:A42]
        Rng.EntireRow.Hidden = Rng.Value = "0"
    Next Rng
    Application.ScreenUpdating = True
    Sheet9.Protect "cc"
End Sub

 

[Vàng A Súp]

Sheet nào bạn bảo vệ vậy?
Trong file bạn có sheet 3 đâu:

Sub Spinner4_Change()
Dim Rng As Range
    Sheet9.Unprotect "cc"
    Application.ScreenUpdating = False
    For Each Rng In [A39:A42]
        Rng.EntireRow.Hidden = Rng.Value = "0"
    Next Rng
    Application.ScreenUpdating = True
    Sheet9.Protect "cc"
End Sub

À bác ơi. Cái vba đấy em chạy cho sheet khác ạ. Không liên quan tới sheet kia ạ

 

[huonglien1901]

À bác ơi. Cái vba đấy em chạy cho sheet khác ạ. Không liên quan tới sheet kia ạ

Bạn vào Insert-Module rồi chèn code vào!
Mình thấy code không báo lỗi.

Sub ABC()
Dim iR&, DK&, X&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    iR = Sheets("Dau_Vao").Range("C" & Rows.Count).End(3).Row
    DK = Sheets("Phu_luc_1").Range("C37").Value
    Sheets("Phu_luc_1").Range("A10:Q33").ClearContents
    For X = 7 To iR Step 25
        If Sheets("Dau_Vao").Range("A" & X).Value = DK Then
            Sheets("Dau_Vao").Range("B" & X).Resize(24, 17).Copy
            Sheets("Phu_luc_1").Range("A10").PasteSpecial Paste:=xlPasteValues
            Exit For
            Application.CutCopyMode = False
        End If
    Next x
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[Vàng A Súp]

Bạn vào Insert-Module rồi chèn code vào!
Mình thấy code không báo lỗi.

Sub ABC()
Dim iR&, DK&, X&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    iR = Sheets("Dau_Vao").Range("C" & Rows.Count).End(3).Row
    DK = Sheets("Phu_luc_1").Range("C37").Value
    Sheets("Phu_luc_1").Range("A10:Q33").ClearContents
    For X = 7 To iR Step 25
        If Sheets("Dau_Vao").Range("A" & X).Value = DK Then
            Sheets("Dau_Vao").Range("B" & X).Resize(24, 17).Copy
            Sheets("Phu_luc_1").Range("A10").PasteSpecial Paste:=xlPasteValues
            Exit For
            Application.CutCopyMode = False
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Dạ vâng ạ. Để mai em có máy tính em thử lại xem..có gì bác giúp lại em với nhé

 

[SA_DQ]

@ Chủ bài đăng: Bạn bỏ trộn các ô trong vùng chép đến lá đạt được cho khâu chép dữ liệu

Chú ý thêm: Để khử lỗi phát sinh bạn tru7o071c khi chép đến cần bỏ trộn các ô trong vùng;
Sau khi chép ta có thể tiến hành trộn ô cho diêm dúa (có thể bằng thủ công hay tự động)

Chúc vui & thành công!

 

[Vàng A Súp]

@ Chủ bài đăng: Bạn bỏ trộn các ô trong vùng chép đến lá đạt được cho khâu chép dữ liệu

Chú ý thêm: Để khử lỗi phát sinh bạn tru7o071c khi chép đến cần bỏ trộn các ô trong vùng;
Sau khi chép ta có thể tiến hành trộn ô cho diêm dúa (có thể bằng thủ công hay tự động)

Chúc vui & thành công!

Hì hì. Bác làm giúp em với được không bác. Kiến thức VBA em còn kém lắm vẫn chưa hiểu bác ạ. Code kia cũng là nhờ người viết hộ bác ạ.

 

[SA_DQ]

Trước tiên bạn kiểm xem trong vùng chép đến có bao nhiêu ô đang bị trộn lại;
(*) Tô màu chúng lên & tiến hành bỏ trộn;
Tiến hành chạy 'Code'

Sau khi chạy Code xong; Tiến hành mở bộ thu macro lên & tiến hành trộn các ô
Xem macro nó viết như thế nào.
(Có thể đưa nội dung macro đó qua tin nhắn cho mình để xem có cần thiết 'Kiện toàn' nó hơn không!)

 

[SA_DQ]

Bạn thử xài 3 macro này xem sao:

Sub ABC()
 Dim iR&, DK&, X&

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 iR = Sheets("Dau_Vao").Range("C" & Rows.Count).End(xlUp).Row
 With Sheets("Phu_luc_1")
    .Select
    DK = Range("C37").Value
    Range("A10:Q33").ClearContents
    BoTronVungO [A35:B35]:              BoTronVungO [b33:d33]
    BoTronVungO [A34:j34]:              BoTronVungO [m34:q34]
    BoTronVungO [c35:q35]
    For X = 7 To iR Step 25
        If Sheets("Dau_Vao").Range("A" & X).Value = DK Then
            Sheets("Dau_Vao").Range("B" & X).Resize(24, 17).Copy
            .Range("A10").PasteSpecial Paste:=xlPasteValues
            Exit For
        End If
    Next X
    TronVungO [A35:B35]:                TronVungO [b33:d33]
    TronVungO [A34:j34]:                TronVungO [m34:q34]
    TronVungO [c35:q35]
 End With
 Application.CutCopyMode = False
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True
End Sub

Sub BoTronVungO(Rng As Range)
    Rng.Select
    On Error Resume Next
    Selection.UnMerge
End Sub

Sub TronVungO(Rng As Range)
  Rng.Select
  On Error Resume Next
  Selection.Merge (True)
End Sub

 

[ptm0412]

Lỗi 1: Merge cell B33: D33, không cho paste value
Lỗi 2: gỡ Merge cell, chỉ copy paste được 1 lần, lần sau bất kể spin button có giá trị bao nhiêu, DK đều bằng 0. Lý do thì tự tìm hiểu
Lỗi 3: Exit For rồi exit sub luôn thì câu lệnh Application.CutCopyMode = False làm gì có chạy

 

[VetMini]

...Lỗi 3: Exit For rồi exit sub luôn thì câu lệnh Application.CutCopyMode = False làm gì có chạy

Tôi bị cái vụ nhảy một hơi mấy blocks này hoài.
Hồi nào mình quen mấy ngôn nhữ mỗi lần nhảy chỉ được 1 block (trừ lệnh returrn/exit).
Gặp VBA cho nhảy tùm lum, đọc mấy cái code bà con nhảy block rầu muốn chết