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 SubIf Len(temp) > 0 Then
Application.InputBox Type:=8
Anh gợi ý cho em bẫy lỗi như nào với ạ?
Câu lệnh mang chỉ số dòng là 7 đó có nội dung là
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
Application.DisplayAlerts = False
On Error Resume Next
Set RgKH = Application.InputBox("Nhập ô hiển kết quả", ,"$W$2", Type:=8)
Application.DisplayAlerts = True
If RgKH Is Nothing Then Exit Sub
Dim userInput As String
Dim ResultRange As Range
userInput = InputBox("Nhập địa chỉ vùng (ví dụ: A1:B2)", "Chọn vùng")
If userInput = "" Then
MsgBox "Bạn chưa nhập vùng nào!", vbExclamation, "Thông báo"
Exit Sub
End If
On Error Resume Next
Set ResultRange = Range(userInput)
On Error GoTo 0
If ResultRange Is Nothing Then
MsgBox "Địa chỉ vùng không hợp lệ!", vbCritical, "Lỗi"
Exit Sub
End If
MsgBox "Bạn đã chọn vùng: " & ResultRange.AddressPublic Const BienDoiTuongChuaSET As Long = 1234
Sub SetObject()
Dim eRng As Range, GPE As Integer
On Error GoTo LoiCT
Application.DisplayAlerts = False
GPE = Application.InputBox("Nhâp Vùng:", "Chon Vùng", Type:=8)(1).Value
If eRng Is Nothing Then
Err.Raise BienDoiTuongChuaSET, "Input Vùng", "Ngu Lâu!"
End If
' Tiêp Viêc Xu Lý Vói eRng... '
KThuc:
Application.DisplayAlerts = True
Exit Sub
LoiCT:
MsgBox "Lôi: " & Err.Description, vbExclamation, "Thông Báo Lôi"
GoTo KThuc
End SubVẫn vậy anh ạ. Câu If eRng Is Nothing Then chả bao giờ xét đến nên câu mắng "Ngu Lâu!" chẳng bao giờ xuất hiện.
Đó là biện pháp thay thế mà anh? Copilot nó bảo thế, nếu nghe theo thì phải tự gõ "f1" chẳng hạn.
(1) Vậy mới gây ra lỗi ý mà!
Dim abc As Variant
abc = Application.InputBox(...)
If abc = False then
...DisplayAlerts = False hay quá ạ.
dạ. Đúng ạ. em muốn tìm cái giống DisplayAlerts = False
