Công thức để lấy tất cả các giá trị cung tham số trên 1 ô khi sử dụng Pivot Table

Liên hệ QC

DUNG HOANG

Thành viên mới
Tham gia
25/5/14
Bài viết
6
Được thích
0
Mình có 1 bảng dữ liệu về đơn hàng: gồm mã hàng, tên hàng, số lượng và tên khách hàng.
khi sử dụng Pivot Table thì lấy được mã hàng, sum ò số lượng. nhưng làm cách nào để có được dữ liệu là mã hàng đó là những khách hàng nào đặt?
Ai biết giúp mình với.
 

File đính kèm

  • PO.xlsx
    12.8 KB · Đọc: 24
Bạn kéo thả luôn trường khách hàng vào row
 
THANKS PTM0412. Nhưng như vậy mình k sử dụng bảng tính đó cho mục đích khác được. Mình cần thông tin như cột vàng trong file
View attachment 122169
Bạn tham khảo code sau (nhấn Alt+F11 để xem code):
[gpecode=vb]
Private Sub Worksheet_Activate()
Dim Cll As Range, iR As Long, Tmp As String, sArr()
sArr = Sheet2.Range("A2:D" & Sheet2.Range("A65535").End(3).Row).Value
For Each Cll In Sheet1.Range("A4:A" & Sheet1.Range("A65535").End(3).Row - 1)
Tmp = ""
For iR = LBound(sArr) To UBound(sArr)
If sArr(iR, 1) = Cll Then
Tmp = Tmp & ", " & sArr(iR, 4)
Cll.Offset(, 2) = Right(Tmp, Len(Tmp) - 2)
End If
Next iR
Next Cll
End Sub
[/gpecode]
 

File đính kèm

  • PO.xlsm
    28.8 KB · Đọc: 18
Bạn tham khảo code sau (nhấn Alt+F11 để xem code):

Code này chạy với 94 mã hàng và 103 dòng dữ liệu, sẽ lặp gần 10.000 vòng. Nếu dùng Dic sẽ chỉ lặp 103 vòng chính, mỗi vòng sẽ tìm kiếm trong Dic và nối vào, nhanh hơn.
(Trước đó nạp sheet1 vào Dic 94 vòng lặp)
 
Lần chỉnh sửa cuối:
Bạn tham khảo code sau (nhấn Alt+F11 để xem code):
[gpecode=vb]
Private Sub Worksheet_Activate()
Dim Cll As Range, iR As Long, Tmp As String, sArr()
sArr = Sheet2.Range("A2:D" & Sheet2.Range("A65535").End(3).Row).Value
For Each Cll In Sheet1.Range("A4:A" & Sheet1.Range("A65535").End(3).Row - 1)
Tmp = ""
For iR = LBound(sArr) To UBound(sArr)
If sArr(iR, 1) = Cll Then
Tmp = Tmp & ", " & sArr(iR, 4)
Cll.Offset(, 2) = Right(Tmp, Len(Tmp) - 2)
End If
Next iR
Next Cll
End Sub
[/gpecode]

Tất nhiên phải làm như anh ptm0412 đã nói.

Tôi xét khía cạnh khác. Giả sử ta vẫn dùng code của bạn.

Mã:
Private Sub Worksheet_Activate()
Dim Cll As Range, iR As Long, Tmp As String, sArr()
sArr = Sheet2.Range("A2:D" & Sheet2.Range("A65535").End(3).Row).Value
For Each Cll In Sheet1.Range("A4:A" & Sheet1.Range("A65535").End(3).Row - 1)
    Tmp = ""
    For iR = LBound(sArr) To UBound(sArr)
        If sArr(iR, 1) = Cll Then
            Tmp = Tmp & ", " & sArr(iR, 4)
            [COLOR=#ff0000]Cll.Offset(, 2) = Right(Tmp, Len(Tmp) - 2)[/COLOR]
        End If
    Next iR
Next Cll
End Sub

Dòng đỏ đỏ có vấn đề về viết code. Trong dữ liệu có mã 10309546 ứng với 4 khách hàng. Như vậy dòng đỏ đỏ được thực hiện 4 lần để nhập 4 dữ liệu vào cùng 1 ô. Nhưng vì nhập vào cùng 1 ô nên chỉ có dữ liệu nhập cuối cùng (có cả 4 khách hàng) được hiển thị. 3 lần nhập trước sẽ lần lượt bị ghi đè. Thế nếu với dữ liệu nhiều và có 1 mã (10 mã?) ứng với 20 khách thì sao?

Dù ít dù nhiều về mặt lập trình như thế không được. Phải bê dòng đỏ đỏ ra ngoài vòng FOR.

Mã:
Private Sub Worksheet_Activate()
Dim Cll As Range, iR As Long, Tmp As String, sArr()
    sArr = Sheet2.Range("A2:D" & Sheet2.Range("A65535").End(3).Row).Value
    For Each Cll In Sheet1.Range("A4:A" & Sheet1.Range("A65535").End(3).Row - 1)
        Tmp = ""
        For iR = LBound(sArr) To UBound(sArr)
            If sArr(iR, 1) = Cll Then Tmp = Tmp & ", " & sArr(iR, 4)
        Next iR
        [COLOR=#ff0000]Cll.Offset(, 2) = Right(Tmp, Len(Tmp) - 2)[/COLOR]
    Next Cll
End Sub

Nếu là tôi thì trước khi vào vòng FOR "bên trong" tôi sẽ ghi Cll.Value vào biến rồi trong vòng FOR so sánh sArr(iR, 1) với biến đó. Nói chung đọc từ biến ra vẫn nhanh hơn là truy cập vào object để đọc ra thuộc tính của nó.
 
Code này chạy với 94 mã hàng và 103 dòng dữ liệu, sẽ lặp gần 10.000 vòng. Nếu dùng Dic sẽ chỉ lặp 103 vòng chính, mỗi vòng sẽ tìm kiếm trong Dic và nối vào, nhanh hơn.
(Trước đó nạp sheet1 vào Dic 94 vòng lặp)
Cảm ơn Thầy Mỹ đã hướng dẫn và cho giải pháp.
Nếu là tôi thì trước khi vào vòng FOR "bên trong" tôi sẽ ghi Cll.Value vào biến rồi trong vòng FOR so sánh sArr(iR, 1) với biến đó. Nói chung đọc từ biến ra vẫn nhanh hơn là truy cập vào object để đọc ra thuộc tính của nó.
Cảm ơn Thầy siwtom đã chỉ ra những điểm yếu trong code em viết.
Về VBA em tập viết trên GPE, chủ yếu là vòng lặp, chỉ phần khai báo biến thôi em cũng chưa nắm hết, vì vậy sai sót là không thể tránh. Rất mong những góp ý của các Thầy để em mở rộng kiến thức của mình.
Em có viết lại theo giải pháp Thầy Mỹ đưa ra, mong nhận được lời phê của các Thầy:
[gpecode=vb]
Sub Button1_Click()
Dim sArr(), iR As Long, Dic As Object, k As Long, rArr()
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Sheet2.Range("A2:D" & Sheet2.Range("A65535").End(3).Row).Value
ReDim rArr(1 To UBound(sArr), 1 To 3)
For iR = LBound(sArr) To UBound(sArr)
If Not Dic.Exists(sArr(iR, 1)) Then
k = k + 1
Dic.Add sArr(iR, 1), k
rArr(k, 1) = sArr(iR, 1)
rArr(k, 2) = sArr(iR, 3)
rArr(k, 3) = sArr(iR, 4)
Else
rArr(Dic.Item(sArr(iR, 1)), 2) = rArr(Dic.Item(sArr(iR, 1)), 2) + sArr(iR, 3)
rArr(Dic.Item(sArr(iR, 1)), 3) = rArr(Dic.Item(sArr(iR, 1)), 3) & ", " & sArr(iR, 4)
End If
Next iR
Sheet3.[A3:C1000].ClearContents
If k Then Sheet3.[A3].Resize(k, 3) = rArr
Set Dic = Nothing
End Sub
[/gpecode]
 

File đính kèm

  • PO.xlsm
    26.9 KB · Đọc: 9
Cảm ơn Thầy Mỹ đã hướng dẫn và cho giải pháp.

Cảm ơn Thầy siwtom đã chỉ ra những điểm yếu trong code em viết.
Về VBA em tập viết trên GPE, chủ yếu là vòng lặp, chỉ phần khai báo biến thôi em cũng chưa nắm hết, vì vậy sai sót là không thể tránh. Rất mong những góp ý của các Thầy để em mở rộng kiến thức của mình.
Em có viết lại theo giải pháp Thầy Mỹ đưa ra, mong nhận được lời phê của các Thầy:
[gpecode=vb]
Sub Button1_Click()
Dim sArr(), iR As Long, Dic As Object, k As Long, rArr()
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Sheet2.Range("A2:D" & Sheet2.Range("A65535").End(3).Row).Value
ReDim rArr(1 To UBound(sArr), 1 To 3)
For iR = LBound(sArr) To UBound(sArr)
If Not Dic.Exists(sArr(iR, 1)) Then
k = k + 1
Dic.Add sArr(iR, 1), k
rArr(k, 1) = sArr(iR, 1)
rArr(k, 2) = sArr(iR, 3)
rArr(k, 3) = sArr(iR, 4)
Else
rArr(Dic.Item(sArr(iR, 1)), 2) = rArr(Dic.Item(sArr(iR, 1)), 2) + sArr(iR, 3)
rArr(Dic.Item(sArr(iR, 1)), 3) = rArr(Dic.Item(sArr(iR, 1)), 3) & ", " & sArr(iR, 4)
End If
Next iR
Sheet3.[A3:C1000].ClearContents
If k Then Sheet3.[A3].Resize(k, 3) = rArr
Set Dic = Nothing
End Sub
[/gpecode]

Sửa tí tẹo vì chả lý gì lại tính Dic.Item(sArr(iR, 1)) tới 4 lần. Nếu rArr mà có thêm nhiều cột thì lại càng chết.
Tất nhiên ở bài này nhánh ELSE cũng ít thực hiện. Tôi nói là nói về nguyên tắc thôi.

Mã:
Sub Button1_Click()
Dim sArr(), iR As Long, Dic As Object, k As Long, rArr(), index As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheet2.Range("A2:D" & Sheet2.Range("A65535").End(3).Row).Value
    ReDim rArr(1 To UBound(sArr), 1 To 3)
    For iR = LBound(sArr) To UBound(sArr)
        If Not Dic.Exists(sArr(iR, 1)) Then
            k = k + 1
            Dic.Add sArr(iR, 1), k
            rArr(k, 1) = sArr(iR, 1)
            rArr(k, 2) = sArr(iR, 3)
            rArr(k, 3) = sArr(iR, 4)
        Else
            index = Dic.Item(sArr(iR, 1))
            rArr(index, 2) = rArr(index, 2) + sArr(iR, 3)
            rArr(index, 3) = rArr(index, 3) & ", " & sArr(iR, 4)
        End If
    Next iR
    Sheet3.[A3:C1000].ClearContents
    If k Then Sheet3.[A3].Resize(k, 3) = rArr
    Set Dic = Nothing
End Sub
 
Rất cám ơn các thầy và bạn Ptm0412. k biết có cách nào đơn giản hơn không? em không biết gì về viết code nên không biết cách nào ứng dụng được về lâu dài. hàng tuần em đều phải làm file tuơng tự như vậy. mọi người giúp em với!
 
Lần chỉnh sửa cuối:
Rất cấm ơn các thầy và bạn Ptm0412. k biết có cách nào đơn giản hơn không? em không biết gì về viết code nên không biết cách nào ứng dụng được về lâu dài. hàng tuần em đều phải làm file tuơng tự như vậy. mọi người giúp em với!
Nếu cách nối Khách hàng trên đúng với ý bạn rồi thì bạn nên nghiên cứu thêm 1 chút về cách sử dụng code vba. Thực tế công thức không đáp ứng được yêu cầu của bạn, chưa có công thức nối theo điều kiện như vậy. Không nắm được giải thuật trong code thì cần nắm cách sử dụng nó. Nếu khác form thì cứ đưa form lên, mọi người sẽ giúp bạn.
 
cách nối trên đã đúng ý mình rồi. bạn có thể cho mình tài liệu để tham khảo về code không?
Nếu cách nối Khách hàng trên đúng với ý bạn rồi thì bạn nên nghiên cứu thêm 1 chút về cách sử dụng code vba. Thực tế công thức không đáp ứng được yêu cầu của bạn, chưa có công thức nối theo điều kiện như vậy. Không nắm được giải thuật trong code thì cần nắm cách sử dụng nó. Nếu khác form thì cứ đưa form lên, mọi người sẽ giúp bạn.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Web KT
Back
Top Bottom