Xem mô tả trong file thì thấy có vẻ chưa hợp lý. Chẳng lẽ lúc nào cũng lấy dòng 2 của BẢNG NHẬP LIỆU? Có trường hợp nào lấy kết quả ở dòng 3, dòng 4.. hay không?
Vậy tốt nhất bạn cho ví dụ tổng quát chút:
Đâu phải vậy đâu anh
Thêm 1 hàm dùng để nối giá trị từ các cell
Function JoinRng(Sep As String, ParamArray SrcArray()) As String
Dim SubArray, Item, Arr(), i As Long
On Error Resume Next
For Each SubArray In SrcArray
For Each Item In SubArray
If Item <> vbNullString Then
ReDim Preserve Arr(i)
Arr(i) = Item
i = i + 1
End If
Next
Next
JoinRng = Join(Arr, Sep)
End FunctionSub Main()
Dim Chk As CheckBox, SrcRng As Range, TmpRng As Range, Sh As Worksheet
Dim GrpA(), GrpB(), JoinA As String, JoinB As String
Dim iA As Long, iB As Long
On Error Resume Next
Set Sh = Sheets("Sheet1")
Set SrcRng = Sh.Range("F3:K13")
Sh.Range("D5").Value = "A, B"
For Each Chk In Sh.CheckBoxes
If Chk.Value = 1 Then
Set TmpRng = SrcRng.Resize(1).Find(Chk.Caption, , xlValues, xlWhole)
If Not TmpRng Is Nothing Then
Select Case Left(Chk.Caption, 1)
Case "A"
ReDim Preserve GrpA(iA)
GrpA(iA) = Intersect(SrcRng, SrcRng.Offset(1), TmpRng.EntireColumn).Address
iA = iA + 1
Case "B"
ReDim Preserve GrpB(iB)
GrpB(iB) = Intersect(SrcRng, SrcRng.Offset(1), TmpRng.EntireColumn).Address
iB = iB + 1
End Select
End If
End If
Next
If iA Then JoinA = JoinRng("+", Range(Join(GrpA, ",")))
If iB Then JoinB = JoinRng("+", Range(Join(GrpB, ",")))
If iA Or iB Then Sh.Range("D5").Value = Replace(Trim(JoinA & " " & JoinB), " ", ", ")
End SubSub ResetChk()
Dim Chk As CheckBox
On Error Resume Next
For Each Chk In Sheets("Sheet1").CheckBoxes
Chk.Value = 0
Next
Sheets("Sheet1").Range("D5").Value = "A, B"
End Sub-Hình như file của thầy Ndu còn thiếu một chút so với yêu cầu.
Option Explicit
Sub JoinValue()
Dim i As Byte, j As Byte, Kq As String, kq1 As String, kq2 As String
Dim Gt()
Gt = Range("F4:K6").Value
For i = 1 To 6
For j = 1 To 3
If Sheet2.Shapes("Check Box " & i).ControlFormat.Value = 1 Then
If i < 4 Then
kq1 = kq1 & Gt(j, i) & "+"
Else
kq2 = kq2 & Gt(j, i) & "+"
End If
End If
Next
Next
If Len(kq1) > 0 Then kq1 = Left(kq1, Len(kq1) - 1)
If Len(kq2) > 0 Then kq2 = Left(kq2, Len(kq2) - 1)
Kq = kq1 & "," & kq2
If Len(Kq) = 1 Then
Kq = "A,B"
End If
[D5] = Kq
End Sub
