Rút trích dữ liệu

[phihndhsp]

Xin được các thành viên cho lời giải đáp. tôi có 1 vấn đề mà làm không được
Vấn đề
trong file tôi có 2 sheet, thong ke và chi tiet
trong thong ke toi co nhap vào khách hàng. 1 khách hàng có tối đa 2 thẻ, và trên từng dòng tương ứng có sử dụng 1 số dịch vụ có sẳn, tôi muốn điền thông tin vào cột P dựa vào sheet chi tiet
tôi muốn liệt kê ra khách hàng đã xài các dịch vụ tương ứng với từng hàng dịch vụ đang có là bao nhiêu lần, và xài cho những ngày nào?( dạng này tôi đã làm thành công với 2 đk, nhưng bài này nhiều điều quá nên chưa rõ cách làm cho lắm mong được các thành viên xem giúp)
tôi có đính kèm file và có ví dụ cụ thể trong cột P, xin cảm ơn

 

[phihndhsp]

Tôi mới có ý tưởng mới, không biết sử dụng phương thức tìm kiếm như thế nào? nếu không sử dụng phương thức find thì tôi sẽ sử dụng tìm kiếm trên mảng 1 chiều
ý tưởng là trên từng dòng sheet tổng hợp tôi so sánh với toàn cột cột C bên chitiet nếu trùng thì tôi sẽ so sánh tiếp từng dòng của cột F có trùng với dịch vụ mà họ đã xài hay không, nếu trùng thì in ra số ngày và số dịch vụ
ở đây nếu sử dụng mảng chắc chắn tôi sẽ làm được,(chưa có làm).
bây giờ tôi muốn biết để sử dụng phương thức find để tìm 1 giá trị trong 1 vùng chỉ định sẳn thì như thế nào? xin cảm ơn

 

[phihndhsp]

mới tìm thấy code của anh ndu
Sub doccheck()
Dim first As String, TK131 As Range
With Sheet1.Range([D2], [D65000].End(xlUp))
Set TK131 = .Find("131", LookIn:=xlValues)

End With

If TK131 Is Nothing Then
MsgBox " khong tim thay"
Else
MsgBox TK131
End If

End Sub

hy vọng là làm được yêu cầu này

 

[phihndhsp]

Cuối cùng cũng tìm ra được phương pháp giải áp dụng code của anh ndu và bate để giải quyết vấn đề trên

Function kiemtra(PT As String, SODONG As Long)
Dim first As String, TK131 As Range
With Sheet3.Range("E" & SODONG & ":Z" & SODONG)
Set TK131 = .Find(PT, LookIn:=xlValues)
End With

If TK131 Is Nothing Then
kiemtra = 0
Else
kiemtra = 1
End If
End Function

Sub DATA_SOAM_CUOICUNG()


Dim RNGS(), Arr(), I As Long, k As Long, y As Long, J As Long
Dim SODONG As Long
Dim T As String
Dim TAM As String
SODONG = Sheet3.Range("A65000").End(xlUp).Row
On Error Resume Next
With Sheets("DATA CHI TIET")
'With Sheet1
RNGS = .Range(.[A4], .[A60000].End(xlUp)).Resize(, 60).Value
End With
ReDim Arr(1 To UBound(RNGS, 1), 1 To 30)

For J = 2 To SODONG
T = ""
For I = 1 To UBound(RNGS, 1)
TAM = RNGS(I, 6)
If (kiemtra(TAM, J) = 1 And (RNGS(I, 3) = Sheet3.Cells(J, 1) Or RNGS(I, 3) = Sheet3.Cells(J, 2))) Then
T = T & RNGS(I, 6) & " " & ","
End If
Next
k = k + 1
Arr(k, 1) = T

Next
Sheet3.Range("AC2:AZ100000").ClearContents
If (J > 0) Then
Sheet3.Range("AC2").Resize(k, 1).Value = Arr
End If
' Call DINHDANG(k)
'
'

End Sub

 

[phihndhsp]

Nhờ các thành viên xem file này và cho ý kiến. File tôi viết đã chạy tốt, nhưng về vấn đề thời gian thì hơi chậm mong được giải pháp nào nhanh hơn.
Trong file có 2 sheet, sheet DATA CHI TIET và DU LIEU AM
yêu cầu điền dữ liệu vào cột AC trong sheet DU LIEU AM, dựa vào mã khách hàng được xài các dịch vụ trên cùng hàng, so với những dịch vụ đã xài bên sheet DATA CHI TIET
tôi có đính kèm theo file và kết quả hoàn toàn đúng, với mong muốn là được thuật toán nào cho kết quả nhanh hơn
với bài này khi nhấn nút trich loc thì kết quả sẽ ra sau 2 phút. Xin chân thành cảm ơn

 

[leonguyenz]

Nhờ các thành viên xem file này và cho ý kiến. File tôi viết đã chạy tốt, nhưng về vấn đề thời gian thì hơi chậm mong được giải pháp nào nhanh hơn.
Trong file có 2 sheet, sheet DATA CHI TIET và DU LIEU AM
yêu cầu điền dữ liệu vào cột AC trong sheet DU LIEU AM, dựa vào mã khách hàng được xài các dịch vụ trên cùng hàng, so với những dịch vụ đã xài bên sheet DATA CHI TIET
tôi có đính kèm theo file và kết quả hoàn toàn đúng, với mong muốn là được thuật toán nào cho kết quả nhanh hơn
với bài này khi nhấn nút trich loc thì kết quả sẽ ra sau 2 phút. Xin chân thành cảm ơn

Tôi sửa một chút trong code, không dùng hàm kiemtra vì dùng phương thức Find làm giảm tốc độ code, code nhanh hơn của bạn một chút. Tham khảo:

Sub DATA_SOAM_CUOICUNG()
Dim Rngs(), Arr(), i As Long, j As Integer
Dim SoDong As Integer, k As Integer
Dim Tmp As String
SoDong = Sheet3.[A65535].End(3).Row
On Error Resume Next
Rngs = Sheet1.Range("A4:G" & Sheet1.[A65535].End(3).Row).Value2
ReDim Arr(1 To SoDong - 1, 1 To 1)
    For j = 2 To SoDong
        Tmp = ""
        For i = 1 To UBound(Rngs)
            If Rngs(i, 3) = Sheet3.Cells(j, 1) Or Rngs(i, 3) = Sheet3.Cells(j, 2) Then
                For k = 5 To Sheet3.Cells(j, 5).End(2).Column
                    If Rngs(i, 6) = Cells(j, k) Then
                        Tmp = Tmp & CDate(Rngs(i, 1)) & "_" & Rngs(i, 6) & ", "
                    End If
                Next k
            End If
        Next i
        Arr(j - 1, 1) = Tmp
    Next j
    Sheet3.[AC2:AZ65535].ClearContents
    If j Then Sheet3.[AC2].Resize(j - 2) = Arr
End Sub

 

[phihndhsp]

Cảm ơn bạn nhiều, code chạy với tốc độ nhanh gấp 10 lần code cũ