Làm thế nào để ghép dữ liệu ở 2 sheet vào 1 cột (1 người xem)

[txh0107]

Mình muốn hỏi cách ghép dữ liệu ở 2 sheet thành 1 cột như sau: cả 2 sheet đều có dữ liệu chung là Mã khách hàng, ở sheet Tai san thi tương ứng mỗi mã khách hàng có thể có 1 hoặc nhiều mã Tài sản, ghi ghép lại với nhau thành 1 cột thì mã khách hàng sẽ nằm ở dòng trên, bên dưới là mã tài sản, khi hết mã tài sản của mã khách hàng đó thì dòng bên dưới sẽ là mã khách hàng tiếp theo và các mã tài sản của khách hàng đó.

Mình có gửi kèm file ví dụ. Thank các bác nhiều.

 

[Lê Duy Thương]

Mình muốn hỏi cách ghép dữ liệu ở 2 sheet thành 1 cột như sau: cả 2 sheet đều có dữ liệu chung là Mã khách hàng, ở sheet Tai san thi tương ứng mỗi mã khách hàng có thể có 1 hoặc nhiều mã Tài sản, ghi ghép lại với nhau thành 1 cột thì mã khách hàng sẽ nằm ở dòng trên, bên dưới là mã tài sản, khi hết mã tài sản của mã khách hàng đó thì dòng bên dưới sẽ là mã khách hàng tiếp theo và các mã tài sản của khách hàng đó.

Mình có gửi kèm file ví dụ. Thank các bác nhiều.

dùng pivot table, sau đó dùng vlookup để dò tên khách hàng
xem file nhé

 

[Quang_Hải]

Mình muốn hỏi cách ghép dữ liệu ở 2 sheet thành 1 cột như sau: cả 2 sheet đều có dữ liệu chung là Mã khách hàng, ở sheet Tai san thi tương ứng mỗi mã khách hàng có thể có 1 hoặc nhiều mã Tài sản, ghi ghép lại với nhau thành 1 cột thì mã khách hàng sẽ nằm ở dòng trên, bên dưới là mã tài sản, khi hết mã tài sản của mã khách hàng đó thì dòng bên dưới sẽ là mã khách hàng tiếp theo và các mã tài sản của khách hàng đó.
Mình có gửi kèm file ví dụ. Thank các bác nhiều.

Xem cách làm bằng VBA trong file

Sub ghep()
Dim dl1, dl2, kq(), tim, Ftim
Dim i, k
With Sheets("Khach hang")
   dl1 = .Range(.[A2], .[b65536].End(3)).Value
      End With
         With Sheets("Tai san")
            Set dl2 = .Range(.[A2], .[b65536].End(3))
               End With
ReDim kq(1 To UBound(dl1) + dl2.Rows.Count, 1 To 2)
   For i = 1 To UBound(dl1)
      Set tim = dl2.Find(dl1(i, 1))
         If Not tim Is Nothing Then
            k = k + 1
            kq(k, 1) = dl1(i, 1)
               kq(k, 2) = dl1(i, 2)
                  Ftim = tim.Address
            Do
               k = k + 1
                  Set tim = dl2.FindNext(tim)
                     kq(k, 1) = tim.Offset(,1)
            Loop Until Ftim = tim.Address
         End If
   Next
[A2].Resize(k, 2) = kq
End Sub

 

[Lê Duy Thương]

Xem cách làm bằng VBA trong file

Sub ghep()
Dim dl1, dl2, kq(), tim, Ftim
Dim i, k
With Sheets("Khach hang")
   dl1 = .Range(.[A2], .[b65536].End(3)).Value
      End With
         With Sheets("Tai san")
            Set dl2 = .Range(.[A2], .[b65536].End(3))
               End With
ReDim kq(1 To UBound(dl1) + dl2.Rows.Count, 1 To 2)
   For i = 1 To UBound(dl1)
      Set tim = dl2.Find(dl1(i, 1))
         If Not tim Is Nothing Then
            k = k + 1
            kq(k, 1) = dl1(i, 1)
               kq(k, 2) = dl1(i, 2)
                  Ftim = tim.Address
            Do
               k = k + 1
                  Set tim = dl2.FindNext(tim)
                     kq(k, 1) = tim
            Loop Until Ftim = tim.Address
         End If
   Next
[A2].Resize(k, 2) = kq
End Sub

code của quang hải chạy ra kết quả sai với yêu cầu rồi. ý tác giả là trong 1 cột thì mã khách hàng đứng đầu. bên dưới mã khách hàng là mã tài sản. chứ không phải lấy mã tài sản không đâu

 

[Quang_Hải]

code của quang hải chạy ra kết quả sai với yêu cầu rồi. ý tác giả là trong 1 cột thì mã khách hàng đứng đầu. bên dưới mã khách hàng là mã tài sản. chứ không phải lấy mã tài sản không đâu

Um đúng rồi, quên mất cái thằng Offset. Sửa lại code rồi đấy. Tác giả tải lại bài này nhé

 

[Lê Duy Thương]

Xem cách làm bằng VBA trong file

Sub ghep()
Dim dl1, dl2, kq(), tim, Ftim
Dim i, k
With Sheets("Khach hang")
   dl1 = .Range(.[A2], .[b65536].End(3)).Value
      End With
         With Sheets("Tai san")
            Set dl2 = .Range(.[A2], .[b65536].End(3))
               End With
ReDim kq(1 To UBound(dl1) + dl2.Rows.Count, 1 To 2)
   For i = 1 To UBound(dl1)
      Set tim = dl2.Find(dl1(i, 1))
         If Not tim Is Nothing Then
            k = k + 1
            kq(k, 1) = dl1(i, 1)
               kq(k, 2) = dl1(i, 2)
                  Ftim = tim.Address
            Do
               k = k + 1
                  Set tim = dl2.FindNext(tim)
                     kq(k, 1) = tim.Offset(,1)
            Loop Until Ftim = tim.Address
         End If
   Next
[A2].Resize(k, 2) = kq
End Sub

nên thêm dòng này nữa chứ nhỉ

Sheets("Tong hop").Range("a2:c500").Clear

 

[Quang_Hải]

nên thêm dòng này nữa chứ

Tác giả đi mất rồi, chỉ còn chúng ta thôi........ Cũng hỏng biết là tác giả có xài được hay không nữa.