Giúp đỡ trích xuất dữ liệu có điều kiện

Liên hệ QC
A

Avenged7

Thành viên mới
Tham gia
2/1/15
Bài viết
24
Được thích
0
Mấy bác giúp đỡ em xử lý file excel này với ạ. %#^#$
Em cần list ra danh sách các "GroupPoints" trong "Sheet 2" đưa vào "Sheet 1" theo dạng cách nhau theo dấu "," như file đính kèm. Điều kiện là giá trị "GroupPoints" đó xuất hiện từ 2 lần trở lên trong cột "GroupPoints" của "Sheet 2". Giá trị xuất theo từng "POP" đưa vào "Sheet 1"
Đa tạ mọi người /-*+/
 

File đính kèm

Avenged7 đã viết:
Mấy bác giúp đỡ em xử lý file excel này với ạ. %#^#$
Em cần list ra danh sách các "GroupPoints" trong "Sheet 2" đưa vào "Sheet 1" theo dạng cách nhau theo dấu "," như file đính kèm. Điều kiện là giá trị "GroupPoints" đó xuất hiện từ 2 lần trở lên trong cột "GroupPoints" của "Sheet 2". Giá trị xuất theo từng "POP" đưa vào "Sheet 1"
Đa tạ mọi người /-*+/
Nhấp chuột vào đây để mở rộng...

Chạy thử Sub này rồi tuỳ nghi chế biến.
(Đọc không hiểu)
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, K As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet2
    sArr = .Range(.[A2], .[B2].End(xlDown)).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
For I = 1 To UBound(sArr, 1)
    If Not Dic.Exists(sArr(I, 1)) Then
        K = K + 1
        Dic.Add sArr(I, 1), K
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = 1
        dArr(K, 3) = sArr(I, 2)
    Else
        Rws = Dic.Item(sArr(I, 1))
        dArr(Rws, 2) = dArr(Rws, 2) + 1
        dArr(Rws, 3) = dArr(Rws, 3) & "," & sArr(I, 2)
    End If
Next I
With Sheet1
    .[A2].Resize(K, 3) = dArr
    .Range("A2").Resize(K, 3).Sort Key1:=.Range("B2"), Order1:=xlDescending
End With
Set Dic = Nothing
End Sub
-----------------------
Thấy cách làm của hoamattroicoi ở bài dưới (#3), hình như mình hiểu sai vấn đề, làm lại trong file này vậy.
 

File đính kèm

Lần chỉnh sửa cuối:
Avenged7 đã viết:
Mấy bác giúp đỡ em xử lý file excel này với ạ. %#^#$
Em cần list ra danh sách các "GroupPoints" trong "Sheet 2" đưa vào "Sheet 1" theo dạng cách nhau theo dấu "," như file đính kèm. Điều kiện là giá trị "GroupPoints" đó xuất hiện từ 2 lần trở lên trong cột "GroupPoints" của "Sheet 2". Giá trị xuất theo từng "POP" đưa vào "Sheet 1"
Đa tạ mọi người /-*+/
Nhấp chuột vào đây để mở rộng...

Bạn sử dụng hàm này xem sao :
Mã: 
Function Timdulieu(POP As Range, Group As Range)
Dim i As Long, sArr(), dArr, k As Long
Dim Tmp, kQ
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr = POP.Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
If sArr(i, 1) = Group.Value Then
    If Not Dic.exists(sArr(i, 2)) Then
        k = k + 1
        Dic.Add sArr(i, 2), k
        dArr(k, 1) = 1
    Else
    dArr(Dic.Item(sArr(i, 2)), 1) = dArr(Dic.Item(sArr(i, 2)), 1) + 1
    End If
End If
Next
Tmp = Dic.Keys
For i = 0 To Dic.Count - 1
    If dArr(i + 1, 1) > 1 Then
      kQ = Tmp(i) & ", " & kQ
    End If
Next
    If Len(kQ) > 0 Then
        Timdulieu = Left(kQ, Len(kQ) - 2)
    Else
        Timdulieu = ""
    End If
Set Dic = Nothing
End Function

Bạn copy code kia vào module sau đó trong ô B2 trong sheet1 bạn gõ công thức sau :
=Timdulieu(Sheet2!$A$2:$B$324,Sheet1!A2)
=> Copy xuống cho những ô còn lại.
 
Avenged7 đã viết:
Mấy bác giúp đỡ em xử lý file excel này với ạ. %#^#$
Em cần list ra danh sách các "GroupPoints" trong "Sheet 2" đưa vào "Sheet 1" theo dạng cách nhau theo dấu "," như file đính kèm. Điều kiện là giá trị "GroupPoints" đó xuất hiện từ 2 lần trở lên trong cột "GroupPoints" của "Sheet 2". Giá trị xuất theo từng "POP" đưa vào "Sheet 1"
Đa tạ mọi người /-*+/
Nhấp chuột vào đây để mở rộng...

trong sheet2 chèn thêm cột E
Mã: 
E2=IF(COUNTIFS($A$1:A1,A2,$B$1:B1,B2)=1,  IFERROR( LOOKUP(2,1/($A$1:A1=A2)/($E$1:E1<>""),$E$1:E1)&", "&B2,B2),"")

quay về sheet1
Mã: 
B2=IFERROR( LOOKUP(2,1/(Sheet2!$A$2:$A$900=A2)/(Sheet2!$E$2:$E$900<>""),Sheet2!$E$2:$E$900),"")
 
Lần chỉnh sửa cuối:
hoamattroicoi đã viết:
Bạn sử dụng hàm này xem sao :
Mã: 
Function Timdulieu(POP As Range, Group As Range)
Dim i As Long, sArr(), dArr, k As Long
Dim Tmp, kQ
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr = POP.Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
If sArr(i, 1) = Group.Value Then
    If Not Dic.exists(sArr(i, 2)) Then
        k = k + 1
        Dic.Add sArr(i, 2), k
        dArr(k, 1) = 1
    Else
    dArr(Dic.Item(sArr(i, 2)), 1) = dArr(Dic.Item(sArr(i, 2)), 1) + 1
    End If
End If
Next
Tmp = Dic.Keys
For i = 0 To Dic.Count - 1
    If dArr(i + 1, 1) > 1 Then
      kQ = Tmp(i) & ", " & kQ
    End If
Next
    If Len(kQ) > 0 Then
        Timdulieu = Left(kQ, Len(kQ) - 2)
    Else
        Timdulieu = ""
    End If
Set Dic = Nothing
End Function

Bạn copy code kia vào module sau đó trong ô B2 trong sheet1 bạn gõ công thức sau :
=Timdulieu(Sheet2!$A$2:$B$324,Sheet1!A2)
=> Copy xuống cho những ô còn lại.
Nhấp chuột vào đây để mở rộng...

dù là Sub hay Function thì cũng chỉ có 1 vòng lặp thui , có giao lưu không ? hi hi
 
doveandrose đã viết:
dù là Sub hay Function thì cũng chỉ có 1 vòng lặp thui , có giao lưu không ? hi hi
Nhấp chuột vào đây để mở rộng...

Ngưởi đẹp doveandrose quyến rũ, hihihi

Mã: 
Function Timdulieu(POP As Range, Group As Range)Dim i As Long, sArr(), dArr, k As Long, Tmp, kQ
Dim Dic As Object, Dic2 As Object
Set Dic1 = CreateObject("Scripting.dictionary")
Set Dic2 = CreateObject("Scripting.dictionary")
sArr = POP.Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
If sArr(i, 1) = Group.Value Then
    If Not Dic1.exists(sArr(i, 2)) Then
        k = k + 1
        Dic1.Add sArr(i, 2), k
        dArr(k, 1) = 1
    Else
    dArr(Dic1.Item(sArr(i, 2)), 1) = dArr(Dic1.Item(sArr(i, 2)), 1) + 1
        If dArr(Dic1.Item(sArr(i, 2)), 1) > 1 Then
            If Not Dic2.exists(sArr(i, 2)) Then
                Dic2(sArr(i, 2)) = ""
                kQ = sArr(i, 2) & ", " & kQ
            End If
        End If
    End If
End If
Next
If Len(kQ) > 0 Then
Timdulieu = Left(kQ, Len(kQ) - 2)
Else
Timdulieu = ""
End If
Set Dic1 = Nothing
Set Dic2 = Nothing
End Function
 
hoamattroicoi đã viết:
Ngưởi đẹp doveandrose quyến rũ, hihihi

Mã: 
Function Timdulieu(POP As Range, Group As Range)Dim i As Long, sArr(), dArr, k As Long, Tmp, kQ
Dim Dic As Object, Dic2 As Object
Set Dic1 = CreateObject("Scripting.dictionary")
Set Dic2 = CreateObject("Scripting.dictionary")
sArr = POP.Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
If sArr(i, 1) = Group.Value Then
    If Not Dic1.exists(sArr(i, 2)) Then
        k = k + 1
        Dic1.Add sArr(i, 2), k
        dArr(k, 1) = 1
    Else
    dArr(Dic1.Item(sArr(i, 2)), 1) = dArr(Dic1.Item(sArr(i, 2)), 1) + 1
        If dArr(Dic1.Item(sArr(i, 2)), 1) > 1 Then
            If Not Dic2.exists(sArr(i, 2)) Then
                Dic2(sArr(i, 2)) = ""
                kQ = sArr(i, 2) & ", " & kQ
            End If
        End If
    End If
End If
Next
If Len(kQ) > 0 Then
Timdulieu = Left(kQ, Len(kQ) - 2)
Else
Timdulieu = ""
End If
Set Dic1 = Nothing
Set Dic2 = Nothing
End Function
Nhấp chuột vào đây để mở rộng...

giờ thí dụ như chỉ cho phép 1 Dic và không cần dArr thì sao ta ? hi hi
 
- 12 dòng code thì giống kiểu cưỡng hôn quá người đẹp ợ, nhưng bạn đẹp bạn có quyền :D....18 dòng code của mình vượt budget rùi, mình chờ 12 dòng code của người đẹp }}}}}

Mã: 
Function Timdulieu(POP As Range, Group As Range)
Dim i As Long, sArr(), k As Long, kQ, Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr = POP.Value
For i = 1 To UBound(sArr)
If sArr(i, 1) = Group.Value Then
    If Not Dic.exists(sArr(i, 2)) Then
         k = k + 1
         Dic.Add sArr(i, 2), Array(k, 1)
    Else
            Dic.Item(sArr(i, 2)) = Array(Dic.Item(sArr(i, 2))(0), Dic.Item(sArr(i, 2))(1) + 1)
            If Dic.Item(sArr(i, 2))(1) = 2 Then kQ = sArr(i, 2) & ", " & kQ
    End If
End If
Next
If Len(kQ) > 0 Then Timdulieu = Left(kQ, Len(kQ) - 2)
Set Dic = Nothing
End Function
 
Lần chỉnh sửa cuối:
hoamattroicoi đã viết:
- 12 dòng code thì giống kiểu cưỡng hôn quá người đẹp ợ....18 dòng code của mình vượt budget rùi, mình chờ 12 dòng code của người đẹp }}}}}

Mã: 
Function Timdulieu(POP As Range, Group As Range)
Dim i As Long, sArr(), k As Long, kQ, Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr = POP.Value
For i = 1 To UBound(sArr)
If sArr(i, 1) = Group.Value Then
    If Not Dic.exists(sArr(i, 2)) Then
         k = k + 1
         Dic.Add sArr(i, 2), Array(k, 1)
    Else
            Dic.Item(sArr(i, 2)) = Array(Dic.Item(sArr(i, 2))(0), Dic.Item(sArr(i, 2))(1) + 1)
            If Dic.Item(sArr(i, 2))(1) = 2 Then kQ = sArr(i, 2) & ", " & kQ
    End If
End If
Next
If Len(kQ) > 0 Then Timdulieu = Left(kQ, Len(kQ) - 2)
Set Dic = Nothing
End Function
Nhấp chuột vào đây để mở rộng...

ồ có vẻ Hoamattroicoi đã nhìn thấy bản chất công thức của #4 rùi . hi hi
doveandrose thật áy náy vì báo hại Hoamattroicoi không được ngủ sớm .
doveandrose không dám múa rìu qua mắt ních xanh đâu , nhưng vì được mời nên cố gắng làm thử vậy
Mã: 
Public Function HoamattroiDeThuong(POP As Range, Group As Range) As String
Dim Dic As Object, arr, dk, st As String, r As Long
Set Dic = CreateObject("Scripting.dictionary")
arr = POP.Value: dk = Group.Value
For r = 1 To UBound(arr) Step 1
    If arr(r, 1) = dk Then
        Dic(arr(r, 2)) = Dic(arr(r, 2)) + 1
        If Dic(arr(r, 2)) = 2 Then st = st & ", " & arr(r, 2)
    End If
Next
HoamattroiDeThuong = Mid(st, 3)
End Function
 
Người ta bảo ép dầu, ép mỡ chứ ai nỡ ép code. Sáng nay định ép nốt code nhưng người đẹp dậy sớm đã tiếp sức nhanh quá.

Ngày xưa thầy mình dạy không nên tư duy code theo công thức.
 
hoamattroicoi đã viết:
Người ta bảo ép dầu, ép mỡ chứ ai nỡ ép code. Sáng nay định ép nốt code nhưng người đẹp dậy sớm đã tiếp sức nhanh quá.

Ngày xưa thầy mình dạy không nên tư duy code theo công thức.
Nhấp chuột vào đây để mở rộng...
1) Vậy "bi giờ" ép tiếp đi, với dữ liệu như trong bài, đừng xài "đít to đít bé" gì nữa, vẫn một vòng lặp đi với....2 thằng If
2) Nếu dùng Sub lấy kết quả cho 10 em ở cột A sheet1 cùng lúc có thể sử dụng bộ lọc cho vòng lặp chạy ít thôi
Mới nghĩ ra thế, "hông" biết đúng "hông" nữa, bé Còi đừng bắt bác Cò làm nhé. Thân
Híc
 
Lần chỉnh sửa cuối:
OK rồi. Đa tạ mấy bác :D

Giờ em cần thêm 2 yêu cầu này nữa ạ, mấy bác giúp em nốt phát

1. Chuyển cột 3 trong sheet 1 từ dạng "cách nhau dấu phẩy" sang dạng từng thành phần trên mỗi cell (như sheet 2). (Nghĩa là làm ngược lại ấy ạ).

2. Lọc từ cột 3, các "thành phần chỉ có một dấu chấm", mà xuất hiện từ 2 lần trở lên, đưa vào cột 2 (như sheet 1)
Ví dụ : Cột 3 có: NTGP006.10.0066, NTGP006.10.0065, NTGP006.10.0070... thì lấy NTGP006.10 đưa vào cột 2.

Giải thích hơi loằng ngoằng, hi vọng mọi người hiểu... !$@!!
 

File đính kèm

concogia đã viết:
1) Vậy "bi giờ" ép tiếp đi, với dữ liệu như trong bài, đừng xài "đít to đít bé" gì nữa, vẫn một vòng lặp đi với....2 thằng If
Nhấp chuột vào đây để mở rộng...
2 IF khó nuốt quá bác Cò ơi, bé còi 3 IF nha bác Cò, hihihi
Mã: 
Function Timdulieu(POP As Range, Group As Range)
Dim i As Long, sArr(), kQ, onPOP As String
sArr = POP.Value
For i = 1 To UBound(sArr)
If sArr(i, 1) = Group.Value Then
    If InStr(1, onPOP, sArr(i, 2)) = 0 Then
            onPOP = onPOP & sArr(i, 2)
    Else
            If InStr(1, kQ, sArr(i, 2)) = 0 Then kQ = kQ & ", " & sArr(i, 2)
    End If
End If
Next
Timdulieu = Mid(kQ, 3)
End Function
 
hoamattroicoi đã viết:
2 IF khó nuốt quá bác Cò ơi, bé còi 3 IF nha bác Cò, hihihi
Mã: 
Function Timdulieu(POP As Range, Group As Range)
Dim i As Long, sArr(), kQ, onPOP As String
sArr = POP.Value
For i = 1 To UBound(sArr)
If sArr(i, 1) = Group.Value Then
    If InStr(1, onPOP, sArr(i, 2)) = 0 Then
            onPOP = onPOP & sArr(i, 2)
    Else
            If InStr(1, kQ, sArr(i, 2)) = 0 Then kQ = kQ & ", " & sArr(i, 2)
    End If
End If
Next
Timdulieu = Mid(kQ, 3)
End Function
Nhấp chuột vào đây để mở rộng...
Híc, cái này tính 2 If là ok rồi, nhìn thấy gọn quá xá cỡ, bé Còi ....giỏi quá
 
Avenged7 đã viết:
OK rồi. Đa tạ mấy bác :D

Giờ em cần thêm 2 yêu cầu này nữa ạ, mấy bác giúp em nốt phát

1. Chuyển cột 3 trong sheet 1 từ dạng "cách nhau dấu phẩy" sang dạng từng thành phần trên mỗi cell (như sheet 2). (Nghĩa là làm ngược lại ấy ạ).

2. Lọc từ cột 3, các "thành phần chỉ có một dấu chấm", mà xuất hiện từ 2 lần trở lên, đưa vào cột 2 (như sheet 1)
Ví dụ : Cột 3 có: NTGP006.10.0066, NTGP006.10.0065, NTGP006.10.0070... thì lấy NTGP006.10 đưa vào cột 2.

Giải thích hơi loằng ngoằng, hi vọng mọi người hiểu... !$@!!
Nhấp chuột vào đây để mở rộng...

Tiếp chiêu số 1 nhé, số 2 loằng ngoằng khó hiểu quá.
Không chơi với Merge Cells nhé, nếu muốn thì bạn làm thủ công.
PHP: 
Public Sub GPE_1()
Dim sArr(), dArr(1 To 1000000, 1 To 2), I As Long, J As Long, K As Long, Tem
sArr = Sheet1.Range(Sheet1.[A2], Sheet1.[C2].End(xlDown)).Value
For I = 1 To UBound(sArr, 1)
    K = K + 1:          dArr(K, 1) = sArr(I, 1):        K = K - 1
    Tem = Split(sArr(I, 3), ", ")
    For J = 0 To UBound(Tem)
        K = K + 1:      dArr(K, 2) = Tem(J)
    Next J
Next I
Sheet2.[A2:B2].Resize(K) = dArr
End Sub
 
Lần chỉnh sửa cuối:
Ba Tê đã viết:
Tiếp chiêu số 1 nhé, số 2 loằng ngoằng khó hiểu quá.
Không chơi với Merge Cells nhé, nếu muốn thì bạn làm thủ công.
PHP: 
Public Sub GPE_1()
Dim sArr(), dArr(1 To 1000000, 1 To 2), I As Long, J As Long, K As Long, Tem
sArr = Sheet1.Range(Sheet1.[A2], Sheet1.[C2].End(xlDown)).Value
For I = 1 To UBound(sArr, 1)
    K = K + 1:          dArr(K, 1) = sArr(I, 1):        K = K - 1
    Tem = Split(sArr(I, 3), ", ")
    For J = 0 To UBound(Tem)
        K = K + 1:      dArr(K, 2) = Tem(J)
    Next J
Next I
Sheet2.[A2:B2].Resize(K) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...

Làm sao để dùng code này vậy bác, em gà mờ vụ này :.,
Bác nào giúp em cái 2 với ạ **~**
 
Ba Tê đã viết:
Khi mở file, chọn Enable Macros, bấm nút ở sheet2
Alt+F11 thấy Code
Nhấp chuột vào đây để mở rộng...

Được rồi bác %#^#$
Bác giúp em nốt cái 2 với ạ. Cái này nghĩa là trích những thằng nào dạng "NTGP0xx.xx" xuất hiện từ 2 lần trờ lên đưa vào cột 2 trong "Sheet 1".

Cảm ơn bác nhiều @$@!^%
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

P
Xin trợ giúp cách lập lịch trực tịnh tiến dần cho 1 nhóm người.
Trả lời
3
Đọc
82
phambahoang
P
N
Tính tổng với điều kiện gần đúng
Trả lời
3
Đọc
26
HUONGHCKT
H
C
Trách nhiệm pháp lý của chi nhánh doanh nghiệp Việt Nam tại nước ngoài với Công ty tại Việt Nam
Trả lời
0
Đọc
14
cuongtri
C
HeSanbi
  • Đã giải quyết
LocalizeXL v1.73 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
71
Đọc
10K
HeSanbi
HeSanbi
Bùi Thúy Thúy
  • Question Question
Lấy dữ liệu thời tiết Accuweather để điền vào nhật ký thi công
2 3 4
Trả lời
63
Đọc
19K
Mutants Men
M
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
304
Đọc
21K
axa00000019
axa00000019
Anxseo
  • Đã khóa
Cách crack my excel
Trả lời
1
Đọc
76
HeSanbi
HeSanbi
phatnguyen7301
  • Question Question
Tạo âm thanh khi nhấn vào một phím
Trả lời
5
Đọc
219
yaaasoo01
Y
anhtuan1066
  • Question Question
Chèn hình vào cell bằng hàm tự tạo
    • Thích
    • Ngạc nhiên
10 11 12
Trả lời
235
Đọc
106K
XaNguyen
X
vc_đi chơi
Khóa Hoặc mã hóa File excel có độ bảo mật cao
    • Cảm ơn
    • Thích
Trả lời
3
Đọc
159
Hoangkhang01213
Hoangkhang01213
VietHoangPhan
Excel lỗi không hiển thị dữ liệu, dãn dòng tất cả các file
Trả lời
2
Đọc
34
VietHoangPhan
VietHoangPhan
V
  • Question Question
Tách số liệu từ bảng tính ngang theo điều kiện
Trả lời
13
Đọc
275
HieuCD
H
F
Ẩn công thức trong Google Sheets
Trả lời
2
Đọc
39
FATA11
F
minhquipk
  • Question Question
Cách nhận biết những ô đã bị thay đổi giá trị khi thay đổi giá trị dữ liệu ở những ô khác
Trả lời
3
Đọc
89
le_vis
L
H
Tìm kết quả trả về theo loại
Trả lời
9
Đọc
92
VetMini
V
LongHoang123
  • Question Question
Xin hướng dẫn: Cách tạo vùng in dựa trên dữ liệu của listbox bằng VBA!!!
Trả lời
4
Đọc
102
LongHoang123
LongHoang123
M
  • Question Question
"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel
2 3 4
Trả lời
63
Đọc
15K
SonBDND
S
Q
Hỏi về công thức dò giá
Trả lời
6
Đọc
199
thanthanhan0801
T
N
  • Question Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
6
Đọc
334
nguyenhuong34
nguyenhuong34
ThanhPhongDN
hỏi về cách thay đổi giá trị một ô sau khi nhập một giá trị vào đó
Trả lời
7
Đọc
144
vietduc147258
V
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom