Nối Chuỗi có điều kiện trong excel (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

huele289

Thành viên mới
Tham gia
24/3/13
Bài viết
3
Được thích
0
Chào các bác
E có 1 file cần nối chuỗi theo file đính kèm
e muốn nối chuỗi theo điều kiện sau, những ID nào giống nhau sẽ nối chuỗi cột đó là
VD: ID 23567 - ToA-cột nối (ToA,ToB,ToC)
23567 - ToB-cột nối (ToA,ToB,ToC)
23567 - ToC-cột nối (ToA,ToB,ToC)
Các bác nào có cao kiến xin chỉ giáo cho e ạ
Thank các bác nhiều
 

File đính kèm

Chào các bác
E có 1 file cần nối chuỗi theo file đính kèm
e muốn nối chuỗi theo điều kiện sau, những ID nào giống nhau sẽ nối chuỗi cột đó là
VD: ID 23567 - ToA-cột nối (ToA,ToB,ToC)
23567 - ToB-cột nối (ToA,ToB,ToC)
23567 - ToC-cột nối (ToA,ToB,ToC)
Các bác nào có cao kiến xin chỉ giáo cho e ạ
Thank các bác nhiều
Ghi kết quả vào cột bên cạnh xem nào. Mô tả chẳng hiểu mô tê gì ráo
 
E gửi lại 1 ví dụ minh hoạ, kèm file lại
Nhờ a chỉ giáo dùm e nhé

1527782192711.png
Thanks!
 

File đính kèm

File đính kèm

E gửi lại 1 ví dụ minh hoạ, kèm file lại
Nhờ a chỉ giáo dùm e nhé

View attachment 196531
Cảm ơn!
Cho bạn 2 lựa chọn:
1> Code 1 chỉ nối chuỗi, không lọc duy nhất:
Mã:
Sub CombineText1()
  Dim aSource
  Dim sKey, sItem As String
  Dim dic As Object
  Dim lR As Long, idx As Long
  aSource = Sheet1.Range("A8:B30000").Value
  Set dic = CreateObject("Scripting.Dictionary")
  ReDim aDes(1 To UBound(aSource, 1), 1 To 1)
  For lR = 1 To UBound(aSource, 1)
    sKey = aSource(lR, 1)
    If sKey <> Empty Then
      sItem = aSource(lR, 2)
      If Not dic.Exists(sKey) Then
        dic.Add sKey, sItem
      Else
        dic.item(sKey) = dic.item(sKey) & ", " & sItem
      End If
    End If
  Next
  For lR = 1 To UBound(aSource, 1)
    sKey = aSource(lR, 1)
    If sKey <> Empty Then aDes(lR, 1) = dic.item(sKey)
  Next
  Sheet1.Range("C8").Resize(lR - 1).Value = aDes
End Sub
2> Code 2 vừa nối chuỗi vừa lọc duy nhất sang khu vực khác:
Mã:
Sub CombineText2()
  Dim aSource
  Dim sKey, sItem As String
  Dim dic As Object
  Dim lR As Long, idx As Long
  aSource = Sheet1.Range("A8:B30000").Value
  Set dic = CreateObject("Scripting.Dictionary")
  ReDim aDes(1 To UBound(aSource, 1), 1 To 2)
  For lR = 1 To UBound(aSource, 1)
    sKey = aSource(lR, 1)
    If sKey <> Empty Then
      sItem = aSource(lR, 2)
      If Not dic.Exists(sKey) Then
        idx = idx + 1
        dic.Add sKey, idx
        aDes(idx, 1) = sKey
        aDes(idx, 2) = sItem
      Else
        aDes(dic.item(sKey), 2) = aDes(dic.item(sKey), 2) & ", " & sItem
      End If
    End If
  Next
  If idx Then Sheet1.Range("F8:G8").Resize(idx).Value = aDes
End Sub
theo tôi thì code 2 hợp lý hơn, vì chẳng lý nào cùng 1 ID mà cứ liệt kê ra hết
 
Lần chỉnh sửa cuối:
Anh có cách nào để tạo 1 hàm excel ko ạ, vì e copy đoạn code vào VBA thì nó ko thực hiện đuợc lệnh, e phải kích run để chạy
bác có cao kiến nào chỉ e với
Thank bác nhiều
 
Anh có cách nào để tạo 1 hàm excel ko ạ, vì e copy đoạn code vào VBA thì nó ko thực hiện đuợc lệnh, e phải kích run để chạy
bác có cao kiến nào chỉ e với
Thank bác nhiều
Hàm đương nhiên là viết được nhưng với dữ liệu 20000 dòng của bạn thì chắc chắn sẽ lết bánh
 
Web KT

Bài viết mới nhất

Back
Top Bottom