Fix lỗi Application.InputBox Type:=8 (2 người xem)

[cdshtz88]

Ở phần inputbox khi em không chọn, hoặc chưa chọn vùng để thực thi lệnh mà bấm OK sẽ báo lỗi như kia.
Em muốn là check lỗi nếu không nhập gì thì sẽ hiện MsgBox.
Em đã thử các kiểu GPT, Gemini mà không ra kết quả.

Các anh các thầy hướng dẫn em fix với ạ. Code đầy đủ em có đính kèm.

 

[SA_DQ]

Sub GhepChuoiThongTin()
 Dim OutCol As Range, Row As Range, Cl As Range
 Dim Temp As String, Sep As String:                         Dim i As Long
 Const TBao As String = "Thông Báo' "
 
 On Error GoTo Loi
    ' --- Kiem tra workbook --- '
1 If Application.Workbooks.Count = 0 Then Exit Sub  '?? 
    ' --- Kiem tra vung chon ---    '
2 If (Selection Is Nothing) Or (TypeName(Selection) <> "Range") Then
    MsgBox "1 Ban chua chon vùng du liêu cân ghép ô.", vbCritical, TBao
    Exit Sub
 End If
3 If Selection.Areas.Count > 1 Then
    MsgBox "2 Ban da chon nhiêu vùng không liên kê, chi duoc chon 1 vùng duy nhât.", vbExclamation, TBao
    Exit Sub
 End If
    ' --- Nhâp ký tu ngan cách ---      '
4 Sep = InputBox("Nhâp ký tu chèn giua các phân tu duoc ghép:" & vbCrLf & _
    "(Vi du: dâu cách, dâu phay, dâu gach...)", "Tùy chon ký tu", " ")
 If Sep = vbNullString Then Sep = " "
    ' --- Chon cot ket qua ---      '
  On Error Resume Next
5 Set OutCol = Application.InputBox("Chon côt dê ghi kêt qua (chi chon 1 côt):", "Chon côt kêt qua", Type:=8)
 On Error GoTo Loi
6 If OutCol.Columns.Count > 1 Then
    MsgBox "Chi duoc chon 1 côt duy nhât.", vbExclamation, "Thông báo!"
    Exit Sub
 End If
    ' --- Ghep tung hang (theo thu tu, khong phu thuoc vi tri that) --- '
 i = 0
7 For Each Row In Selection.Rows
    Temp = ""
    For Each Cl In Row.Cells
        If Trim(Cl.Text) <> "" Then Temp = Temp & Cl.Text & Sep
    Next Cl
    If Len(Temp) > 0 Then Temp = Left(Temp, Len(Temp) - Len(Sep))
        OutCol.Cells(1, 1).Offset(i, 0).Value = "" & Temp
        i = i + 1
    Next Row
    MsgBox "Da ghép xong du liêu vào côt " & OutCol.Address(False, False) & ".", vbInformation, "Hoàn tât!"
 Exit Sub
Loi:
 MsgBox "Có lôi xây ra trong quá trình ghép ô!", vbCritical, "Dòng Lôi: " & Erl
End Sub

Thứ nhất:
Tác giả bài đăng thấy các lệnh trong macro trên có chỗ nào sai hay không, phát hiện dùm nha?
Thứ đến:
Viết như mình thì chủ bài đăng sẽ thấy ngay sai sót ở dòng lệnh mà mình winh số 7, khi chưa cần chạy code đâu nghe!
& và còn nhiều thứ nữa cần viết để chúng ta cần tiêu hóa đứa con tinh thần của bạn!

 

[cdshtz88]

Thứ nhất:
Tác giả bài đăng thấy các lệnh trong macro trên có chỗ nào sai hay không, phát hiện dùm nha?
Thứ đến:
Viết như mình thì chủ bài đăng sẽ thấy ngay sai sót ở dòng lệnh mà mình winh số 7, khi chưa cần chạy code đâu nghe!
& và còn nhiều thứ nữa cần viết để chúng ta cần tiêu hóa đứa con tinh thần của bạn!

If Len(temp) > 0 Then
temp = Left(temp, Len(temp) - Len(sep))
OutCol.Cells(1, 1).Offset(i, 0).Value = temp
i = i + 1
End If
Đoạn này thiếu end If phải không ạ?

 

[cdshtz88]

Thứ nhất:
Tác giả bài đăng thấy các lệnh trong macro trên có chỗ nào sai hay không, phát hiện dùm nha?
Thứ đến:
Viết như mình thì chủ bài đăng sẽ thấy ngay sai sót ở dòng lệnh mà mình winh số 7, khi chưa cần chạy code đâu nghe!
& và còn nhiều thứ nữa cần viết để chúng ta cần tiêu hóa đứa con tinh thần của bạn!

Application.InputBox Type:=8

Cái này là thuật toán mặc định của Excel hay sao ấy anh ạ. Nên là khi dữ liệu trong input không đúng thì sẽ hiện cảnh báo mặc định của excel. Nên em chưa tìm ra cách để tối ưu cái này.

 

[ongke0711]

Cái này có vẻ là lỗi do cái inputbox đầu tiên gây ra khi thêm ký tự đầu dẫn đến excel nó xem là nhập công thức. Bạn thử bẫy lỗi nếu cái inputbox thứ 2 nếu là "" thì xoá luôn ký tự từ inputbox 1 hoặc thay đổi thứ tự code input box

 

[cdshtz88]

Cái này có vẻ là lỗi do cái inputbox đầu tiên gây ra khi thêm ký tự đầu dẫn đến excel nó xem là nhập công thức. Bạn thử bẫy lỗi nếu cái inputbox thứ 2 nếu là "" thì xoá luôn ký tự từ inputbox 1 hoặc thay đổi thứ tự code input box

Anh gợi ý cho em bẫy lỗi như nào với ạ?
Em tự vọc thôi nên không rành lắm ạ.

Em có thử đổi cái chọn vùng xuất dữ liệu ra trước, và tham khảo chatgpt để check đầu vào

If OutCol Is Nothing Then
MsgBox "Ban chua chon vung xuat du lieu.", vbExclamation, "Thong bao!"
Exit Sub
End If
If OutCol.Address = "" Then
MsgBox "Ban chua chon vung xuat du lieu.", vbExclamation, "Thong bao!"
Exit Sub
End If

nhưng vẫn không được.

 

[SA_DQ]

. . .
Đoạn này thiếu end If phải không ạ?

Câu lệnh mang chỉ số dòng là 7 đó có nội dung là
For Each Row In Selection.Rows
Trước tiên phải xác định với nhau là Selection.Rows là (con) số dòng của 1 vùng (được) chọn!
Nhưng tham biến Row của bạn lại không phải khai báo dạng số (dòng) mà là vùng ô;
Do cái tật không nêu hay gán đúng tên hay tường minh mà tùy tiện xài tên các tham biến mà nên;

Mình cho rằng cần tường minh như
Dim Rws As Long, LRw As Long, fRw As Long, fCol As Integer . . .
Dim Rng As Range, Cls As Range, Rg0 As Range ,. . . .
Thậm chí
Dim Dg As Long, DgC As Long, Cot As Integer (cho dễ vì tiếng mẹ đẽ!)

 

[SA_DQ]

Chủ bài đăng thử trãi nghiệm với con macro này:

Sub GhepVungONhieuCot()
    Dim sRng As Range, Cls As Range, RgKH As Range
    Dim Dg As Long
    Const FC As String = "; "
    Dim TmpStr As String
    Dim Arr() As String
    
    On Error GoTo LoiCT    
    ' Nhập vùng dữ liệu  '
    Set sRng = Application.InputBox("Nhập vùng gồm >= 2 cột", "$D$4:$G$9", Type:=8)
    If sRng Is Nothing Then
        MsgBox "Bạn đã hủy hoặc nhập sai vùng!"
        Exit Sub
    End If    
    If sRng.Columns.Count < 2 Then
        MsgBox "Bạn cần chọn ít nhất 2 cột!", vbExclamation, "Bye!"
        Exit Sub
    End If    
    ' Nhập ô kết quả    '
    Set RgKH = Application.InputBox("Nhập ô hiển kết quả", "$W$2", Type:=8)
    If RgKH Is Nothing Then Exit Sub
    
    ReDim Arr(1 To sRng.Rows.Count, 1 To 1)
    
    ' Ghép dữ liệu từng dòng   '
    For Dg = 1 To sRng.Rows.Count
        TmpStr = ""
        For Each Cls In sRng.Rows(Dg).Cells
            If Trim(Cls.Text) <> "" Then TmpStr = TmpStr & Cls.Text & FC
        Next Cls
        If Len(TmpStr) > 0 Then TmpStr = Left(TmpStr, Len(TmpStr) - Len(FC)) ' bỏ dấu ; cuối
        Arr(Dg, 1) = TmpStr
    Next Dg    
    ' Xuất kết quả   '
    RgKH.Resize(sRng.Rows.Count).Value = Arr
    
    Exit Sub    
LoiCT:
    MsgBox "Có lỗi xảy ra: " & Err.Description, vbCritical
End Sub