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