Xin chào Thầy Cô và Anh Chị cùng các bạn!
Em có một vấn đề do hơi khó giải thích nên em đã viết vào file đính kèm.
Nhờ mọi người giúp đỡ em với ạ!
Em xin cảm ơn.
Sub GPE_test()
Dim rng1 As Range, rng2 As Range
For Each rng1 In Range("I3:I8")
n = 0
For Each rng2 In Range("F5:F16")
If rng1 = rng2 Then
If n < 3 Then
rng1.Offset(, 6 + n) = rng2.Offset(, 1)
Else
rng1.Offset(, 8) = rng1.Offset(, 8) + rng2.Offset(, 1)
End If
n = n + 1
End If
Next
Next
End Sub
Tại K3 bạn dùng công thức sau rồi kéo sang các ô khác
Mã:=IFERROR(INDEX($G$5:$G$16,SMALL(IF($F$5:$F$16=$I3,ROW($5:$16),""),COLUMN(A:A))-4),"")
Xin chào Thầy Cô và Anh Chị cùng các bạn!
Em có một vấn đề do hơi khó giải thích nên em đã viết vào file đính kèm.
Nhờ mọi người giúp đỡ em với ạ!
Em xin cảm ơn.
Sub tt()
Dim sarr() As Variant, kq(), Dic As Object
sarr = [f5:g16].Value
ReDim kq(1 To UBound(sarr), 1 To 5)
Set Dic = CreateObject("Scripting.Dictionary")
k = 1
For i = 1 To UBound(sarr)
If Not Dic.Exists(sarr(i, 1)) And sarr(i, 1) <> "" Then
Dic.Add sarr(i, 1), ""
kq(k, 1) = sarr(i, 1)
kq(k, 3) = sarr(i, 2)
k = k + 1
Else
l = 1
For Each v In Dic.Keys
If sarr(i, 1) = v And kq(l, 4) = "" Then kq(l, 4) = sarr(i, 2)
l = l + 1
Next
End If
kq(i, 5) = kq(i, 3) + kq(i, 4)
Next
[o3].Resize(k, 5).Value = kq
Set Dic = Nothing
End Sub
Bạn thay như thế nàyRất cảm ơn sử giúp đỡ của mọi người,
Em test cả code và công thức đều đúng.
Tuy nhiên với công thức trên em chưa hiểu lắm nên đã tách dữ liệu làm 2 sheets.
Phiền anh sửa lại công thức trên vào file đính kèm hiện tại lại giúp em với ạ,để em so sánh với công thức cũ mong rằng sẽ hiểu được vấn đề hơn.
Xin cảm ơn!
=IFERROR(INDEX([B]Sheet1!$E$7:$E$18[/B],SMALL(IF([B]Sheet1!$D$7:$D$18=$I3[/B],ROW($5:$16),""),COLUMN(A:A))-4),"")
Bạn thay như thế này
Mã:=IFERROR(INDEX([B]Sheet1!$E$7:$E$18[/B],SMALL(IF([B]Sheet1!$D$7:$D$18=$I3[/B],ROW($5:$16),""),COLUMN(A:A))-4),"")
tôi đang tập tành viết code, mượn bài của bạn làm bài tập
nhớ chấm điểm nha....kàkà....
Mã:Sub tt() Dim sarr() As Variant, kq(), Dic As Object sarr = [f5:g16].Value ReDim kq(1 To UBound(sarr), 1 To 5) Set Dic = CreateObject("Scripting.Dictionary") k = 1 For i = 1 To UBound(sarr) If Not Dic.Exists(sarr(i, 1)) And sarr(i, 1) <> "" Then Dic.Add sarr(i, 1), "" kq(k, 1) = sarr(i, 1) kq(k, 3) = sarr(i, 2) k = k + 1 Else l = 1 For Each v In Dic.Keys If sarr(i, 1) = v And kq(l, 4) = "" Then kq(l, 4) = sarr(i, 2) l = l + 1 Next End If kq(i, 5) = kq(i, 3) + kq(i, 4) Next [o3].Resize(k, 5).Value = kq Set Dic = Nothing End Sub
Mình giải thích cho bạn như thế này:Anh Ninh giả thích giúp em ROW($5:$16) và COLUMN(A:A))-4) với ạ?
ROW($5:$16) em mới hiểu là 12 dòng tương ứng với 12 dòng điểm của sheets 1 không hiểu như vậy có đúng không?
Còn COLUMN(A:A))-4) thì là thế nào ạ?
Mình giải thích cho bạn như thế này:
- Phần màu đỏ: sẽ tạo 1 mảng gồm 12 phần tử từ 5=>16 tức là {5,6,7.......,16}
- Phần màu xanh: Bạn để ý COLUMN(A:A))-4) sds phần ) là của hàm Column còn phần ) là của hàm Small => Toàn bộ phần bạn hỏi là kết quả của phép trừ giữa giá trị Small và 4
bạn test thử code sau:
Mã:Sub GPE_test() Dim rng1 As Range, rng2 As Range For Each rng1 In Range("I3:I8") n = 0 For Each rng2 In Range("F5:F16") If rng1 = rng2 Then If n < [COLOR=#ff0000][B]3[/B][/COLOR] Then rng1.Offset(, [COLOR=#ff0000][B]6[/B][/COLOR]+ n) = rng2.Offset(, 1) Else rng1.Offset(, [COLOR=#ff0000][B]8[/B][/COLOR]) = rng1.Offset(, [B][COLOR=#ff0000]8[/COLOR][/B]) + rng2.Offset(, [COLOR=#ff0000][B]1[/B][/COLOR]) End If n = n + 1 End If Next Next End Sub
Anh ơi các chỉ số 3,6,8,1 là gì vậy ạ. Em muốn thêm dữ liệu mà sử dụng code này không biết sửa chữa ra sao.
Rất mong lại nhận được thêm sự trợ giúp của anh và GPE!