Copy nội dung theo điều kiện

[Hoang Van Vang]

Hi Anh chị E!
M có bài toán nhờ anh chị e giúp đỡ
Giả sử có vùng DL cột A2:E18
Bài toán: Lấy dữ liệu Nội dung đánh dấu chữa "x" ,với điều kiện chuyển DL có giá trị bằng 1 như ở cột F sau đó copy kèm theo ký tự xuống dòng và hiển thị giá trị như cột H
Thêm 1 bài toán nhỏ nữa là tô màu hàng DL từ cột A:E nếu check box trong cột J được tích.
M cảm ơn A chị e rất nhiều

 

[Hoang Van Vang]

up!

 

[leonguyenz]

Hi Anh chị E!
M có bài toán nhờ anh chị e giúp đỡ
Giả sử có vùng DL cột A2:E18
Bài toán: Lấy dữ liệu Nội dung đánh dấu chữa "x" ,với điều kiện chuyển DL có giá trị bằng 1 như ở cột F sau đó copy kèm theo ký tự xuống dòng và hiển thị giá trị như cột H
Thêm 1 bài toán nhỏ nữa là tô màu hàng DL từ cột A:E nếu check box trong cột J được tích.
M cảm ơn A chị e rất nhiều

Code giải quyết vấn đề 1:

Sub Gpe()
Dim A(), B(), C(), i As Long, j As Long, Tmp As String
A = Sheet1.[B2:F18].Value: B = Sheet1.[B1:E1].Value
ReDim C(1 To UBound(A, 1), 1 To 1)
Sheet1.[H2:H65535].ClearContents
For i = 1 To UBound(A, 1)
    If A(i, 5) = 1 Then
        Tmp = ""
        For j = 1 To UBound(A, 2) - 1
            If A(i, j) = "x" Then
                Tmp = Tmp & Chr(10) & B(1, j)
            End If
        Next j
        C(i, 1) = Right(Tmp, Len(Tmp) - 1)
    End If
Next i
Sheet1.[H2].Resize(UBound(A, 1)) = C
End Sub

 

[Hoang Van Vang]

Code giải quyết vấn đề 1:

Sub Gpe()
Dim A(), B(), C(), i As Long, j As Long, Tmp As String
A = Sheet1.[B2:F18].Value: B = Sheet1.[B1:E1].Value
ReDim C(1 To UBound(A, 1), 1 To 1)
Sheet1.[H2:H65535].ClearContents
For i = 1 To UBound(A, 1)
    If A(i, 5) = 1 Then
        Tmp = ""
        For j = 1 To UBound(A, 2) - 1
            If A(i, j) = "x" Then
                Tmp = Tmp & Chr(10) & B(1, j)
            End If
        Next j
        C(i, 1) = Right(Tmp, Len(Tmp) - 1)
    End If
Next i
Sheet1.[H2].Resize(UBound(A, 1)) = C
End Sub

Cảm ơn b rất nhiều!