Lỗi 1004 vba khi tách file trắc nghiệm sang excel

[tby211]

Em không rành VBA, đang cần tìm cách tách trắc nghiệm nên có chạy thử code của 1 bác trên diễn đàn mình nhưng không tách được như file mẫu của bác ấy. Nó báo lỗi 1004 "application defined object defined error" mà em không biết sửa sao. Mong mn giúp đỡ em ạ, em cảm ơn mọi người nhiều.

 

[HUONGHCKT]

Em không rành VBA, đang cần tìm cách tách trắc nghiệm nên có chạy thử code của 1 bác trên diễn đàn mình nhưng không tách được như file mẫu của bác ấy. Nó báo lỗi 1004 "application defined object defined error" mà em không biết sửa sao. Mong mn giúp đỡ em ạ, em cảm ơn mọi người nhiều.

Khuyên bạn không nên viết để nhận được nhiều sự hỗ trợ hơn:
Thay code cũ bằng code này: (vẫn là code cũ sửa lại đôi chút)

S
ub CauHoi()
    Dim i&, k&, aData, aRes
    For i = Range("A65536").End(xlUp).Row To 2 Step -1
        If Cells(i, 1) = "" Then
            Range("A" & i).EntireRow.Delete xlUp
        End If
    Next
    aData = Range("A1:A" & Range("A65536").End(xlUp).Row).Value
    ReDim aRes(1 To UBound(aData), 1 To 7)
    For i = 1 To UBound(aData) ' Step 6
        If aData(i, 1) Like "*Câu*" Then
            k = k + 1
            If Left(aData(i + 1, 1), 2) <> "a." Then
                If aData(i + 1, 1) Like "A.*" Then
                    aRes(k, 1) = Left(aData(i, 1), InStr(1, aData(i, 1), ".") - 1)
                    aRes(k, 2) = Mid(aData(i, 1), InStr(1, aData(i, 1), ".") + 1)
                    aRes(k, 3) = aData(i + 1, 1)
                    aRes(k, 4) = aData(i + 2, 1)
                    aRes(k, 5) = aData(i + 3, 1)
                    aRes(k, 6) = aData(i + 4, 1)
                    aRes(k, 7) = aData(i + 5, 1)
                End If
            End If
        End If
    Next
    Range("B2").Resize(10000, 7).ClearContents
    Range("B2").Resize(k, 7) = aRes
End Sub

 

[BuiQuangThuan]

Khuyên bạn không nên viết để nhận được nhiều sự hỗ trợ hơn:
Thay code cũ bằng code này: (vẫn là code cũ sửa lại đôi chút)

Nếu 1 câu có 2 hoặc 3 đáp án thì thế nào hả chú. Code nó còn chạy đúng không ạ

Bài đã được tự động gộp: 20/4/24

Còn có những câu không có đáp án nữa cơ chú ạ. @HUONGHCKT

 

[HUONGHCKT]

Nếu 1 câu có 2 hoặc 3 đáp án thì thế nào hả chú. Code nó còn chạy đúng không ạ

Trước hết xin chân thành cảm ơn bạn đã xem bài và góp ý.
Quả thật là tôi code còn có sai sót và đã quá hồ đồ khi không test kỹ.
Về vế thứ 2 của câu hỏi, xin không trả lời, bởi vì bạn đã biết đáp án. Bạn hỏi tôi thế với ý gì?
Bạn thông cảm cho tôi nhé (làm xong mà không test kỹ). Thế hệ trẻ như bạn tinh anh hơn lớp già cổ lỗ sỹ chúng tôi nhiều quá. Bái phục.
Nếu có thể bạn code lại cho tôi được mở rộng tầm mắt được không?
Trân trọng.

Bài đã được tự động gộp: 20/4/24

Nếu 1 câu có 2 hoặc 3 đáp án thì thế nào hả chú. Code nó còn chạy đúng không ạ

Bài đã được tự động gộp: 20/4/24

Còn có những câu không có đáp án nữa cơ chú ạ. @HUONGHCKT

Ngóng chờ để được chiêm ngưỡng và thưởng thức học tập code của bạn.

 

[tby211]

Khuyên bạn không nên viết để nhận được nhiều sự hỗ trợ hơn:
Thay code cũ bằng code này: (vẫn là code cũ sửa lại đôi chút)

S
ub CauHoi()
    Dim i&, k&, aData, aRes
    For i = Range("A65536").End(xlUp).Row To 2 Step -1
        If Cells(i, 1) = "" Then
            Range("A" & i).EntireRow.Delete xlUp
        End If
    Next
    aData = Range("A1:A" & Range("A65536").End(xlUp).Row).Value
    ReDim aRes(1 To UBound(aData), 1 To 7)
    For i = 1 To UBound(aData) ' Step 6
        If aData(i, 1) Like "*Câu*" Then
            k = k + 1
            If Left(aData(i + 1, 1), 2) <> "a." Then
                If aData(i + 1, 1) Like "A.*" Then
                    aRes(k, 1) = Left(aData(i, 1), InStr(1, aData(i, 1), ".") - 1)
                    aRes(k, 2) = Mid(aData(i, 1), InStr(1, aData(i, 1), ".") + 1)
                    aRes(k, 3) = aData(i + 1, 1)
                    aRes(k, 4) = aData(i + 2, 1)
                    aRes(k, 5) = aData(i + 3, 1)
                    aRes(k, 6) = aData(i + 4, 1)
                    aRes(k, 7) = aData(i + 5, 1)
                End If
            End If
        End If
    Next
    Range("B2").Resize(10000, 7).ClearContents
    Range("B2").Resize(k, 7) = aRes
End Sub

dạ em không biết code đâu ạ, code này em lấy từ bài viết của một bạn từng đăng bài trên diễn đàn để chạy thử ạ. Chân thành cảm ơn bác đã giúp đỡ ạ.

 

[HUONGHCKT]

dạ em không biết code đâu ạ, code này em lấy từ bài viết của một bạn từng đăng bài trên diễn đàn để chạy thử ạ. Chân thành cảm ơn bác đã giúp đỡ ạ.

Nó chạy chưa đúng toàn bộ đâu. với nhưng câu có kết cấu : Dòng 1 Câu hỏi: Dòng 2 Đáp án A, Dòng tiếp theo Đap án B, dòng tiếp theo đáp án C, dòng tiếp theo Đáp án D, và dòng tiếp theo là đáp án: .XXX . thì code chạy đúng, nếu có ít hơn 4 đáp án thì code sẽ cho ra kết quả thừa.
Code đúng bạn xin Bạn @BuiQuangThuan nhé.