Tìm công thức (1 người xem)

[nasalem]

chào các sư huynh! mong đc chỉ giáo
e gởi file mẫu

 

[nasalem]

hóng mà ko thấy câu trả lời gì hết

 

[phihndhsp]

hóng mà ko thấy câu trả lời gì hết

Công thức dạng bài này chạy chậm lắm nếu dữ liệu nhiều, chép đoạn code bên dưới vào VBA chạy thử xem

Public Sub GPE()
Dim Dic As Object, Arr(), I As Long, J As Long, K As Long
Dim rng As Range
Dim Tem
   
    Set Dic = CreateObject("Scripting.Dictionary")
    Dongcuoi = Sheet1.Range("A65000").End(xlUp).Row
    Set rng = Sheet1.Range("A2:B" & Dongcuoi)
    ReDim Arr(1 To Dongcuoi, 1 To 2)
    
    K = 0
    For I = 1 To Dongcuoi - 1
                Tem = rng(I, 1).Value
            If Not Dic.Exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                Arr(K, 1) = rng(I, 1)
                Arr(K, 2) = rng(I, 2)
             Else
                J = Dic.Item(Tem)
                 Arr(J, 2) = Arr(J, 2) & "," & rng(I, 2)
             End If
        
    Next I




    Sheet1.Range("D6:E10000").ClearContents
    If (K > 0) Then
        Sheet1.Range("D6").Resize(K, 2) = Arr
    End If
    Set Dic = Nothing
  
End Sub

 

[SA_DQ]

Bạn sở hữu 7o bài rồi mà cái tiêu đề chả ra làm sao cả?!?

 

[Let'GâuGâu]

Công thức dạng bài này chạy chậm lắm nếu dữ liệu nhiều, chép đoạn code bên dưới vào VBA chạy thử xem

Public Sub GPE()
Dim Dic As Object, Arr(), I As Long, J As Long, K As Long
Dim rng As Range
Dim Tem
   
    Set Dic = CreateObject("Scripting.Dictionary")
    Dongcuoi = Sheet1.Range("A65000").End(xlUp).Row
    Set rng = Sheet1.Range("A2:B" & Dongcuoi)
    ReDim Arr(1 To Dongcuoi, 1 To 2)
    
    K = 0
    For I = 1 To Dongcuoi - 1
                Tem = rng(I, 1).Value
            If Not Dic.Exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                Arr(K, 1) = rng(I, 1)
                Arr(K, 2) = rng(I, 2)
             Else
                J = Dic.Item(Tem)
                 Arr(J, 2) = Arr(J, 2) & "," & rng(I, 2)
             End If
        
    Next I




    Sheet1.Range("D6:E10000").ClearContents
    If (K > 0) Then
        Sheet1.Range("D6").Resize(K, 2) = Arr
    End If
    Set Dic = Nothing
  
End Sub

bài này tôi làm rồi, quăng luôn cái file lên còn không biết xài, anh viết đoạn code vậy sao mà xài????
cứ đọc lại các bài viết của nick này xem..........toàn là đánh trống bỏ dùi...........hỏi ko đi đến cùng........
ko biết bao giờ mới khá được
=========