thay thế hàm sumifs bằng code (1 người xem)
- Thread starter cachabu
- Ngày gửi
Người dùng đang xem chủ đề này
Quang_Hải
Thành viên gạo cội
- Tham gia
- 21/2/09
- Bài viết
- 6,077
- Được thích
- 8,011
- Nghề nghiệp
- Làm đủ thứ
Chạy thử code này
PHP:
Sub Cong()
Dim arr(), i, j, kq(), Dic As Object
With Sheets("NGUON")
arr = .Range("C3", .[F65536].End(3)).Value
End With
Set Dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
tem = arr(i, 1) & arr(i, 4)
Dic(tem) = Dic.Item(tem) + arr(i, 3)
Next
With Sheets("KQ")
.[C3:E10000].ClearContents
kq = .[B2].CurrentRegion.Value
For i = 2 To UBound(kq)
For j = 2 To UBound(kq, 2)
tem = kq(i, 1) & kq(1, j)
kq(i, j) = Dic.Item(tem)
Next
Next
.[B2].Resize(i - 1, j - 1) = kq
End With
End Sub
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,976
Bài này bạn dùng PivotTable mới là hợp lý nhất
Upvote
0
code chay ok roi em cam on anh hải nhiều a.
Lần chỉnh sửa cuối:
Upvote
0
anh hải có thể giúp em nếu tai sheet kết quả em insert ra thêm 1 cột tại cột c thì code trên sửa lại thể nào vậy ?
code của anh chay được nhưng có điều là tại côt B các mã a,b,c sau khi chạy code thì mất hết công thức tại đó
ví dụ các mã , a,b,c có thể được lấy từ 1 sheet khác bằng công thức, nếu như dùng code của anh thì nó sẽ mất đi hết công thức luôn
anh có cách nào mà không đụng đến cột mã (tức cột B sheet KQ) và dòng điều kiện từ C2 mà vẫn cho ra kết quả đúng được không anh?
có đính kèm lại file
cảm ơn
code của anh chay được nhưng có điều là tại côt B các mã a,b,c sau khi chạy code thì mất hết công thức tại đó
ví dụ các mã , a,b,c có thể được lấy từ 1 sheet khác bằng công thức, nếu như dùng code của anh thì nó sẽ mất đi hết công thức luôn
anh có cách nào mà không đụng đến cột mã (tức cột B sheet KQ) và dòng điều kiện từ C2 mà vẫn cho ra kết quả đúng được không anh?
có đính kèm lại file
cảm ơn
Lần chỉnh sửa cuối:
Upvote
0
anh hải ơi em sửa theo anh rồi nhưng e phải sửa chổ này nữa mới được j=3 nhưng mà tại cột b các mã a,b,c phải là ko chứa công thức thì nó mới ra
còn chứa công thưc thì nó không ra nhờ a xem thêm lỗi này xử lý nó làm sao a nhé
e ví du a,b,c nếu viết bình thường thì ra kết quả còn nếu a,b,c lấy kết quả từ 1 ô nào khác thì nó ko hiểu
cám ơn anh
For j = 3 To UBound(kq, 2)
Lần chỉnh sửa cuối:
Upvote
0
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,123
- Được thích
- 17,590
- Giới tính
- Nam
Từ C2 sang phải, Cột phải có tiêu đề liên tục nhé.
PHP:
Public Sub GPE()
Dim sArr(), dArr(), Rws As Object, Col As Object, I As Long, J As Long
Dim Rw As Long, C As Long, iRw As Long, jCol As Long
Set Rws = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
With Sheets("KQ")
sArr = .Range(.[C2], .[C2].End(xlToRight)).Value
C = UBound(sArr, 2)
For J = 1 To UBound(sArr, 2)
Col.Add sArr(1, J), J
Next J
sArr = .Range(.[B3], .[B3].End(xlDown)).Value
Rw = UBound(sArr, 1)
For I = 1 To UBound(sArr, 1)
Rws.Add sArr(I, 1), I
Next I
End With
ReDim dArr(1 To Rw, 1 To C)
With Sheets("NGUON")
sArr = .Range(.[C3], .[F65536].End(xlUp)).Value
End With
For I = 1 To UBound(sArr, 1)
If Rws.Exists(sArr(I, 1)) Then
If Col.Exists(sArr(I, 4)) Then
iRw = Rws.Item(sArr(I, 1))
jCol = Col.Item(sArr(I, 4))
dArr(iRw, jCol) = dArr(iRw, jCol) + sArr(I, 3)
End If
End If
Next I
Sheets("KQ").[C3].Resize(Rw, C) = dArr
Set Rws = Nothing
Set Col = Nothing
End Sub
Lần chỉnh sửa cuối:
Upvote
0
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,123
- Được thích
- 17,590
- Giới tính
- Nam
Đưa dữ liệu giống thật từ đầu cho khỏi phiền.
Sửa cái C2 thành D2 trong dòng này
PHP:
With Sheets("KQ")
sArr = .Range(.[D2], .[D2].End(xlToRight)).Value '< -----------sửa
PHP:
Sheets("KQ").[D3].Resize(Rw, C) = dArr '<--------Sửa
Lần chỉnh sửa cuối:
Upvote
0
thank anh đã ok rồi cám ơn anh rất nhiều
Upvote
0
Bài viết mới nhất
Tính thời gian làm việc thực tế
(1 người xem)
- Dán lên cao
