Nhờ GPE giúp đỡ nối chuổi

[chisinhvnn]

Mình có 1 bảng dữ liệu, muốn nối chùng tại mới nhau. Ở cột Năm sinh, CMND nếu có dữ liệu thì ghép thêm dòng tiêu đề (Năm sinh, CMND)
Họ tên 1, Họ tên 2 có dữ liệu thì khi nối, Tên ở cột Họ tên 2xuống dòng (trong cùng 1 ô). Nhờ GPE giúp đỡ

 

[phamxuantruong012]

Bạn thử xem được chưa

 

[chisinhvnn]

Bạn thử xem được chưa

Cảm ơn bạn. Mình cần đoạn code để đưa vào trong file của mình.

 

[♫ђöล♥ßล†♥†µ♫]

Cảm ơn bạn. Mình cần đoạn code để đưa vào trong file của mình.

Mình thích Code ... Code ... Code cơ

Sub Noichuoi()
    Dim sArr(), dArr(), I As Long
    Dim Namsinh As String:    Namsinh = "N" & ChrW$(259) & "m sinh"
    With Sheet1
        sArr = .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 10).Value
    End With
    ReDim dArr(1 To UBound(sArr), 1 To 5)
    For I = 1 To UBound(sArr)
        If sArr(I, 3) <> Empty Then
            dArr(I, 1) = sArr(I, 1)
            dArr(I, 2) = sArr(I, 2)
            dArr(I, 3) = "   - " & sArr(I, 3)
            If sArr(I, 4) <> Empty Then dArr(I, 3) = dArr(I, 3) & "; " & Namsinh & ": " & sArr(I, 4)
            If sArr(I, 5) <> Empty Then dArr(I, 3) = dArr(I, 3) & "; " & "CMTND" & ": " & sArr(I, 5)
            If sArr(I, 6) <> Empty Then
                dArr(I, 3) = dArr(I, 3) & Chr(10) & "   - " & sArr(I, 6)
                If sArr(I, 7) <> Empty Then dArr(I, 3) = dArr(I, 3) & "; " & Namsinh & ": " & sArr(I, 7)
                If sArr(I, 8) <> Empty Then dArr(I, 3) = dArr(I, 3) & "; " & "CMTND" & ": " & sArr(I, 8)
            End If
            dArr(I, 4) = sArr(I, 9)
            dArr(I, 5) = sArr(I, 10)
        End If
    Next I
    With Sheet2
        .Range("A2").Resize(I - 1, 5) = dArr
    End With
End Sub

 

[chisinhvnn]

Mình thích Code ... Code ... Code cơ

Sub Noichuoi()
    Dim sArr(), dArr(), I As Long
    Dim Namsinh As String:    Namsinh = "N" & ChrW$(259) & "m sinh"
    With Sheet1
        sArr = .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 10).Value
    End With
    ReDim dArr(1 To UBound(sArr), 1 To 5)
    For I = 1 To UBound(sArr)
        If sArr(I, 3) <> Empty Then
            dArr(I, 1) = sArr(I, 1)
            dArr(I, 2) = sArr(I, 2)
            dArr(I, 3) = "   - " & sArr(I, 3)
            If sArr(I, 4) <> Empty Then dArr(I, 3) = dArr(I, 3) & "; " & Namsinh & ": " & sArr(I, 4)
            If sArr(I, 5) <> Empty Then dArr(I, 3) = dArr(I, 3) & "; " & "CMTND" & ": " & sArr(I, 5)
            If sArr(I, 6) <> Empty Then
                dArr(I, 3) = dArr(I, 3) & Chr(10) & "   - " & sArr(I, 6)
                If sArr(I, 7) <> Empty Then dArr(I, 3) = dArr(I, 3) & "; " & Namsinh & ": " & sArr(I, 7)
                If sArr(I, 8) <> Empty Then dArr(I, 3) = dArr(I, 3) & "; " & "CMTND" & ": " & sArr(I, 8)
            End If
            dArr(I, 4) = sArr(I, 9)
            dArr(I, 5) = sArr(I, 10)
        End If
    Next I
    With Sheet2
        .Range("A2").Resize(I - 1, 5) = dArr
    End With
End Sub

Cảm ơn bạn. Dùng If là chính, thế mà mình cứ nghĩ cho chạy vòng lặp qua các cột rồi để lấy giá trị.

 

[befaint]

mình cứ nghĩ cho chạy vòng lặp qua các cột rồi để lấy giá trị.

 

[HieuCD]

Cảm ơn bạn. Dùng If là chính, thế mà mình cứ nghĩ cho chạy vòng lặp qua các cột rồi để lấy giá trị.

Function GHEPTU(ByVal Rng As Range) As String
    Dim ns As String, cmnd As String, cm As String, tmp As String
    If Rng.Columns.Count <> 6 Then
        GHEPTU = "Ch" & ChrW(7885) & "n vùng có 6 ô liên ti" & ChrW(7871) & "p!!"
        Exit Function
    Else
        ns = ", n" & ChrW(259) & "m sinh: "
        cmnd = ", CMND: ":    cm = ", CMND:"
        tmp = WorksheetFunction.Trim(Rng(1, 1) & ns & Rng(1, 2) & cmnd & Rng(1, 3) & Chr(10) & Rng(1, 4) & ns & Rng(1, 5) & cmnd & Rng(1, 6))
        tmp = Replace(Replace(Replace(tmp, ns & ", ", ", "), cmnd & Chr(10), Chr(10)), Chr(10) & cm, "")
        If Right(tmp, 7) = cm Then tmp = Mid(tmp, 1, Len(tmp) - 7)
        GHEPTU = tmp
    End If
End Function