Tổng hợp & phân loại dữ liệu từ bảng số liệu theo tiêu chí mới (1 người xem)

[ChanhTQ@]

Mình có bảng số liệu thống kê như bảng dưới đây:

A | B
S1|101-108-1020-GPE
S2|102-120-134-R24
S3|108-120-1020-R24

Giờ mình muốn từ đó hình thành bảng thống kê dưới dạng khác chút, đó là:

D | E
101|S1
102|S2
108|S1-S3
120|S2-S3
134|S2
1020|S1-S2
GPE|S1
R24|S2-S3
. . . |. . .

Rất mong các bạn giúp đỡ, xin cảm ơn nhiều!

 

[ndu96081631]

Mình có bảng số liệu thống kê như bảng dưới đây:

A | B
S1|101-108-1020-GPE
S2|102-120-134-R24
S3|108-120-1020-R24

Giờ mình muốn từ đó hình thành bảng thống kê dưới dạng khác chút, đó là:

D | E
101|S1
102|S2
108|S1-S3
120|S2-S3
134|S2
1020|S1-S2
GPE|S1
R24|S2-S3
. . . |. . .

Rất mong các bạn giúp đỡ, xin cảm ơn nhiều!

Cái này thì Dictionary 1 phát ra ngay mà sư phụ

 

[Quang_Hải]

Mình có bảng số liệu thống kê như bảng dưới đây:

A | B
S1|101-108-1020-GPE
S2|102-120-134-R24
S3|108-120-1020-R24

Giờ mình muốn từ đó hình thành bảng thống kê dưới dạng khác chút, đó là:

D | E
101|S1
102|S2
108|S1-S3
120|S2-S3
134|S2
1020|S1-S2
GPE|S1
R24|S2-S3
. . . |. . .

Rất mong các bạn giúp đỡ, xin cảm ơn nhiều!

Hỏng biết sư phụ có ràng buộc điều kiện gì không, nếu giải quyết bình thường thì không khó lắm

Sub vuichoi()
Dim dl, tam, i, j, d As Object
Set d = CreateObject("scripting.dictionary")
dl = Range([a1], [b65536].End(3)).Value
For i = 1 To UBound(dl)
  tam = Split(dl(i, 2), "-")
    For j = 0 To UBound(tam)
      If Not d.exists(tam(j)) Then
        d.Add tam(j), dl(i, 1)
      Else
        d.Item(tam(j)) = d.Item(tam(j)) & "-" & dl(i, 1)
      End If
    Next
Next
[D1].Resize(d.Count) = Application.Transpose(d.keys)
[E1].Resize(d.Count) = Application.Transpose(d.items)
End Sub

 

[ndu96081631]

Hỏng biết sư phụ có ràng buộc điều kiện gì không, nếu giải quyết bình thường thì không khó lắm

Sub vuichoi()
Dim dl, tam, i, j, d As Object
Set d = CreateObject("scripting.dictionary")
dl = Range([a1], [b65536].End(3)).Value
For i = 1 To UBound(dl)
  tam = Split(dl(i, 2), "-")
    For j = 0 To UBound(tam)
      If Not d.exists(tam(j)) Then
        d.Add tam(j), dl(i, 1)
      Else
        d.Item(tam(j)) = d.Item(tam(j)) & "-" & dl(i, 1)
      End If
    Next
Next
[D1].Resize(d.Count) = Application.Transpose(d.keys)
[E1].Resize(d.Count) = Application.Transpose(d.items)
End Sub

Sao hổng thấy bẫy lỗi gì vậy trời?
Dùng mảng 2 chiều thay cho TRANSPOSE sẽ hay hơn

 

[Quang_Hải]

Sao hổng thấy bẫy lỗi gì vậy trời?
Dùng mảng 2 chiều thay cho TRANSPOSE sẽ hay hơn

Vậy em viết thế này, chỉ bẫy lỗi có 1 chỗ không biết đủ chưa nữa

Sub vuichoi()
Dim dl(), tam, kq(1 To 1000, 1 To 2), i, j, k, d As Object
Set d = CreateObject("scripting.dictionary")
dl = Range([a1], [b65536].End(3)).Value
For i = 1 To UBound(dl)
  tam = Split(dl(i, 2), "-")
    For j = 0 To UBound(tam)
      If Not d.exists(tam(j)) Then
        k = k + 1
        d.Add tam(j), k
        kq(k, 1) = tam(j)
        kq(k, 2) = dl(i, 1)
      Else
        kq(d.Item(tam(j)), 2) = kq(d.Item(tam(j)), 2) & "-" & dl(i, 1)
      End If
    Next
Next
If k Then [D1].Resize(k, 2) = kq
End Sub

 

[Ba Tê]

Vậy em viết thế này, chỉ bẫy lỗi có 1 chỗ không biết đủ chưa nữa

Sub vuichoi()
Dim dl(), tam, kq(1 To 1000, 1 To 2), i, j, k, d As Object
Set d = CreateObject("scripting.dictionary")
dl = Range([a1], [b65536].End(3)).Value
For i = 1 To UBound(dl)
  tam = Split(dl(i, 2), "-")
    For j = 0 To UBound(tam)
      If Not d.exists(tam(j)) Then
        k = k + 1
        d.Add tam(j), k
        kq(k, 1) = tam(j)
        kq(k, 2) = dl(i, 1)
      Else
        kq(d.Item(tam(j)), 2) = kq(d.Item(tam(j)), 2) & "-" & dl(i, 1)
      End If
    Next
Next
If k Then [D1].Resize(k, 2) = kq
End Sub

Chắc phải thêm cái đuôi này nữa mới đúng yêu cầu của tác giả:

If k Then
      [D1].Resize(k, 2) = kq
      Range([D1], [D1].End(xlDown)).Resize(, 2).Sort Key1:=[D1]
End If

 

[ndu96081631]

Vậy em viết thế này, chỉ bẫy lỗi có 1 chỗ không biết đủ chưa nữa

Sub vuichoi()
Dim dl(), tam, kq(1 To 1000, 1 To 2), i, j, k, d As Object
Set d = CreateObject("scripting.dictionary")
dl = Range([a1], [b65536].End(3)).Value
For i = 1 To UBound(dl)
  tam = Split(dl(i, 2), "-")
    For j = 0 To UBound(tam)
      If Not d.exists(tam(j)) Then
        k = k + 1
        d.Add tam(j), k
        kq(k, 1) = tam(j)
        kq(k, 2) = dl(i, 1)
      Else
        kq(d.Item(tam(j)), 2) = kq(d.Item(tam(j)), 2) & "-" & dl(i, 1)
      End If
    Next
Next
If k Then [D1].Resize(k, 2) = kq
End Sub

Lở dữ liệu dl(i, 2) = "" thì lấy đâu mà Split
Lở dữ liệu dl(i, 1) = "" thì lấy đâu mà &

 

[Quang_Hải]

Lở dữ liệu dl(i, 2) = "" thì lấy đâu mà Split
Lở dữ liệu dl(i, 1) = "" thì lấy đâu mà &

Em có test thử khi dl(i,1) hoặc dl(i,2) = "" thì cũng không xảy ra lỗi nên liều mạng bỏ qua bẫy lỗi này luôn

 

[ndu96081631]

Em có test thử khi dl(i,1) hoặc dl(i,2) = "" thì cũng không xảy ra lỗi nên liều mạng bỏ qua bẫy lỗi này luôn

Sao mà không có chứ!
dl(i,1) = "" thì sẽ dư ra cái dấu "-"
dl(i,2) = " " thì kết quả xuất ra sẽ.. kỳ cục
Ẹc... Ẹc...
Nói tóm lại: Luôn luôn bẫy lỗi, ít nhất là On Error Resume Next
Tôi thì luôn có thói quen thử hết tất cả các trường hợp đặc biệt (kể cả khi xóa sạch dữ liệu nguồn) xem có lỗi gì không, từ đó định ra điều kiện bẫy lỗi ---> Đến khi chắc ăn không còn lỗi nào cũng không quên thằng em "On Error Resume Next" trên đầu code
Ai biết gì trong trái ổi