Masu1991
Thành viên hoạt động
- Tham gia
- 21/3/20
- Bài viết
- 110
- Được thích
- 14
Chào anh chị, mình có viết một hàm nhưng có một chỗ chưa xử lý được, nhờ anh chị hỗ trợ.
Mình có 1 sheet ABC mình đã lấy ra được các cột, những còn cột E (Res(k, 5) = ) mình chưa làm được. điều kiện để đếm là cột H giá trị là A đếm theo điều kiện ở cột A,B,C,E ở sheet DATA .
Mình cảm ơn
Mình có 1 sheet ABC mình đã lấy ra được các cột, những còn cột E (Res(k, 5) = ) mình chưa làm được. điều kiện để đếm là cột H giá trị là A đếm theo điều kiện ở cột A,B,C,E ở sheet DATA .
Mình cảm ơn
Mã:
Option Explicit
Sub GOPDULIEUM1()
Dim Arr() As Variant, Res() As Variant
Dim Dic As Object, Key As Variant
Dim i As Long, j As Long, k As Long, Lr As Long
Dim sArr() As Variant
Dim total As Double
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DATA")
Lr = .Range("B" & .Rows.count).End(xlUp).Row
Arr = .Range("A2:I" & Lr).Value
sArr = Sheets("ABC").Range("F1:U1").Value
ReDim Res(1 To UBound(Arr), 1 To 22)
For i = 1 To UBound(Arr, 1)
Key = Arr(i, 1) & "_" & Arr(i, 2) & "_" & Arr(i, 3) & "_" & Arr(i, 5)
If Month(Arr(i, 1)) = 6 Then
If Not Dic.Exists(Key) Then
k = k + 1
Dic.Add Key, k
Res(k, 1) = Arr(i, 1)
Res(k, 2) = Arr(i, 2)
Res(k, 3) = Arr(i, 3)
Res(k, 4) = Arr(i, 5)
' Res(k, 5) =
For j = 1 To UBound(sArr, 2)
If Arr(i, 9) = sArr(1, j) Then
Res(k, 5 + j) = 1
End If
Next j
Else
For j = 1 To UBound(sArr, 2)
If Arr(i, 9) = sArr(1, j) Then
Res(Dic.Item(Key), 5 + j) = Res(Dic.Item(Key), 5 + j) + 1
End If
Next j
End If
total = 0
For j = 6 To 21
total = total + Res(Dic.Item(Key), j)
Next j
Res(Dic.Item(Key), 22) = total
End If
Next i
End With
If k Then
Sheets("ABC").Range("a5").Resize(k, 22).ClearContents
Sheets("ABC").Range("a5").Resize(k, 22).Value = Res
End If
Set Dic = Nothing
End Sub
