Gộp dữ liệu từ Sheet 1 qua Sheet 2 có điều kiện (1 người xem)

[andy2208]

Chào ace,
Em có muốn gộp dữ liệu từ sheet 1 sang sheet 2 có điều kiện.
Em có VD 1 hàng trên Sheet 2, nhờ các anh chị giúp em cái macro gộp cho nhanh.

 

[Ba Tê]

Chào ace,
Em có muốn gộp dữ liệu từ sheet 1 sang sheet 2 có điều kiện.
Em có VD 1 hàng trên Sheet 2, nhờ các anh chị giúp em cái macro gộp cho nhanh.

Trợn mắt đoán mò, không trúng thì trật.
[GPECODE=vb]Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long
With Sheet1
sArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 14).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
For I = 1 To UBound(sArr, 1)
dArr(I, 1) = sArr(I, 1)
dArr(I, 2) = sArr(I, 2)
dArr(I, 3) = sArr(I, 8)
dArr(I, 4) = sArr(I, 13)
dArr(I, 5) = sArr(I, 14)
For J = 3 To 7
dArr(I, 2) = dArr(I, 2) & ";" & sArr(I, J)
Next J
For J = 9 To 12
dArr(I, 3) = dArr(I, 3) & ";" & sArr(I, J)
Next J
Next I
Sheet2.[A2].Resize(I - 1, 5) = dArr
End Sub[/GPECODE]

 

[Quang_Hải]

Chào ace,
Em có muốn gộp dữ liệu từ sheet 1 sang sheet 2 có điều kiện.
Em có VD 1 hàng trên Sheet 2, nhờ các anh chị giúp em cái macro gộp cho nhanh.

Đây cũng là code đoán mò, hỏng trúng thì tèo

Sub quanghai()
Dim nguon(), kq(), I, J, k, ID()
With Sheets("sheet1")
    nguon = .Range(.[A1], .[A65536].End(3)).Resize(, 14).Value
End With
With Sheets("sheet2")
    ID = .Range(.[A1], .[A1].End(2)).Value
End With
ReDim kq(1 To UBound(nguon), 1 To UBound(ID, 2))
For I = 2 To UBound(nguon)
    For k = 2 To 14
        For J = 2 To UBound(ID, 2)
            If InStr(ID(1, J), Left(nguon(1, k), 3)) Then
                kq(I - 1, 1) = nguon(I, 1)
                If kq(I - 1, J) <> "" Then
                    kq(I - 1, J) = kq(I - 1, J) & "," & nguon(I, k)
                Else
                    kq(I - 1, J) = nguon(I, k)
                End If
                Exit For
            End If
        Next
    Next
Next
Sheet2.[A2].Resize(I - 1, UBound(ID, 2)) = kq
End Sub

 

[andy2208]

Đoạn code đúng rồi đó anh Ba Tê.
Nhưng em gộp theo điều kiện dựa vào hàng tiêu đề đầu khi 4 ký tự đầu tiên giống nhau thì sẽ gộp,
còn khác nhau thì dữ liệu giữ nguyên và các cột tiêu đề đó tự gộp lại.

 

[andy2208]

Sao đoạn code của anh quanghai1969 em chạy không ra được, dữ liệu bị trống.

 

[Quang_Hải]

Sao đoạn code của anh quanghai1969 em chạy không ra được, dữ liệu bị trống.

Xem file. Nhớ phải có cái dòng vàng vàng nha
Chú ý dòng code, có thể thay số 3 bằng số khác khi muốn thay đổi dk gộp. Code này lấy 3 ký tự đầu giống nhau sẽ gộp lại

If InStr(ID(1, J), Left(nguon(1, k), 3)) Then

 

[andy2208]

nếu em có 1 file dữ liệu khác nhiều column dữ liệu hơn nữa thì sửa code sao anh,
và hàng highlight vàng tiêu đề macro tự gộp lại chứ không làm tay.

 

[Ba Tê]

nếu em có 1 file dữ liệu khác nhiều column dữ liệu hơn nữa thì sửa code sao anh,
và hàng highlight vàng tiêu đề macro tự gộp lại chứ không làm tay.

Rối mắt với kiểu ghép ghép nầy quá.
Thử cái nữa xem sao, không rảnh để "ngâm kiếu" cho gọn lại được.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, Tem As String, C As Long, Col As Long
With Sheet1
    C = .[A1].End(xlToRight).Column
    sArr = .Range(.[A1], .[A1].End(xlDown)).Resize(, C).Value2
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To C)
For I = 1 To UBound(sArr, 1)
    dArr(I, 1) = sArr(I, 1)
    dArr(I, 2) = sArr(I, 2)
Next I
    Tem = Left(sArr(1, 2), 3)'<---------------Thay 3 thanh 4'
    Col = 2
For J = 3 To C
    If Left(sArr(1, J), 3) <> Tem Then'<------------- 3 thanh 4'
        Col = Col + 1
        Tem = Left(sArr(1, J), 3)'<-----------------3 thanh 4'
        dArr(1, Col) = sArr(1, J)
        If dArr(1, Col - 1) <> sArr(1, J - 1) Then dArr(1, Col - 1) = dArr(1, Col - 1) & "-" & sArr(1, J - 1)
            For I = 2 To UBound(sArr, 1)
                dArr(I, Col) = sArr(I, J)
            Next I
    Else
        For I = 2 To UBound(sArr, 1)
            dArr(I, Col) = dArr(I, Col) & ";" & sArr(I, J)
        Next I
    End If
Next J
   Sheet2.[A4].Resize(UBound(sArr, 1), Col).Value2 = dArr
End Sub

Nếu bạn muốn lấy 4 ký tự đầu của tiêu đề để so sánh thì thay các số 3 thành số 4 trong code trên.

 

[andy2208]

Cám ơn anh BaTê nhiều.

 

[andy2208]

Em còn gặp 1 vấn đề là khi dữ liệu trống thì chạy macro nó sẽ ra (;1;1 ) do cells thứ 1 không có dữ liệu,
hoặc (1;;2 do cells thứ 2 & 4 không có dữ liệu.
Em muốn nó thành (1;1) hoặc (1;2) thôi, dữ liệu cell nào trống nó sẽ tự dồn, tiêu đề vẫn giữ như macro chạy ra.

 

[Ba Tê]

Em còn gặp 1 vấn đề là khi dữ liệu trống thì chạy macro nó sẽ ra (;1;1 ) do cells thứ 1 không có dữ liệu,
hoặc (1;;2 do cells thứ 2 & 4 không có dữ liệu.
Em muốn nó thành (1;1) hoặc (1;2) thôi, dữ liệu cell nào trống nó sẽ tự dồn, tiêu đề vẫn giữ như macro chạy ra.

Yêu cầu thì nêu rõ từ đầu, mỗi lúc thêm một chút thì bạn tự chỉnh code đi.

For I = 2 To UBound(sArr, 1)
            dArr(I, Col) = dArr(I, Col) & ";" & sArr(I, J) '<-------Nghien cuu chinh sua lai dong nay'
Next I

Híc!

 

[andy2208]

cám ơn anh góp ý, tại phát sinh thêm.