Dùng hàm index và match là được bạn nhé!Chào các bác!
Em đang có một bài toán tính giá thành căn cứ vào bảng giá cho trước nhưng dữ liệu tham chiếu theo cả hàng và cột ạ
Các bác giúp em một code để có thể tự tìm kiếm với ạ
Em cảm ơn ạ
Cảm ơn bác,Dùng hàm index và match là được bạn nhé!
Lưu ý: Hiện mình dùng Excel 365 còn bản thấp hơn mình không rõ có dùng được không!
View attachment 299662
Tình hình là bạn phải đặt tên riêng không thì sẽ rối ren như Nga và Út Na.
Sub Macro2()
Application.CutCopyMode = False
Dim Vung As Range
On Error GoTo Thoat
Set Vung = Application.InputBox("Chon vung tinh:", , "$D$4:$G$7", , , , , 8)
Vung.Formula2R1C1 = Evaluate("""=SUM(MMULT((RC1=_CotKhachHangOBen)*(RC2=_CotLoaiDichVuOBen)*(R3C=_CotNoiDungDichVuOBen)*_BangGiaOBen,(--TRANSPOSE(RC3=_DongPhuongTienOBen))))""")
Vung = Vung.Value
Vung.Select
Thoat:
Application.CutCopyMode = True
End Sub
Nếu không dùng công thức mảng bạn có thể tham khảo cách sử dụng cột phụ trong bảng giá như sau:Cảm ơn bác,
hiện tại em đang dùng Office 2016, muốn chạy cái này cần dùng dưới dạng mảng mới chạy được, mà dữ liệu nhiều quá, nó thực sự chạy quá chậm
Góp vui.Chào các bác!
Em đang có một bài toán tính giá thành căn cứ vào bảng giá cho trước nhưng dữ liệu tham chiếu theo cả hàng và cột ạ
Các bác giúp em một code để có thể tự tìm kiếm với ạ
Em cảm ơn ạ
Option Explicit
Sub HA()
Dim i&, j&, lr&, t&, k&
Dim Arr(), Arr1(), KQ()
Dim Dic As Object, Key, Temp
Dim Sh As Worksheet, Ws As Worksheet
Dim Ten As String, LoaiDV As String, LoaiPT As String, NoiDungDV As String
Application.ScreenUpdating = False
Set Sh = Sheets("BangGia")
lr = Sh.Cells(100000, 1).End(xlUp).Row
Arr = Sh.Range("A3:I" & lr).Value
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
For j = 4 To UBound(Arr, 2)
Key = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3) & "|" & Arr(1, j)
Dic(Key) = Arr(i, j)
Next j
Next i
Set Ws = Sheets("Bang1")
Arr1 = Ws.Range("A14: G" & Ws.Cells(100000, 1).End(xlUp).Row).Value
ReDim KQ(1 To UBound(Arr1), 1 To 4)
For i = 2 To UBound(Arr1)
t = t + 1: k = 0
Ten = Arr1(i, 1)
LoaiDV = Arr1(i, 2)
LoaiPT = Arr1(i, 3)
For j = 4 To UBound(Arr1, 2)
NoiDungDV = Arr1(1, j): k = k + 1
Temp = Ten & "|" & LoaiDV & "|" & NoiDungDV & "|" & LoaiPT
For Each Key In Dic.Keys
If Key = Temp Then KQ(t, k) = Dic(Key): Exit For
Next Key
Next j
Next i
If t Then
Ws.Range("D15").Resize(100000, 4).ClearContents
Ws.Range("D15").Resize(t, 4) = KQ
End If
Set Dic = Nothing
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
E cảm ơn bác nhiều ạ,Tình hình là bạn phải đặt tên riêng không thì sẽ rối ren như Nga và Út Na.
OBen: có nghĩa là "ở bển"
View attachment 299665Mã:Sub Macro2() Application.CutCopyMode = False Dim Vung As Range On Error GoTo Thoat Set Vung = Application.InputBox("Chon vung tinh:", , "$D$4:$G$7", , , , , 8) Vung.Formula2R1C1 = Evaluate("""=SUM(MMULT((RC1=_CotKhachHangOBen)*(RC2=_CotLoaiDichVuOBen)*(R3C=_CotNoiDungDichVuOBen)*_BangGiaOBen,(--TRANSPOSE(RC3=_DongPhuongTienOBen))))""") Vung = Vung.Value Vung.Select Thoat: Application.CutCopyMode = True End Sub
Em cảm ơn bác ạNếu không dùng công thức mảng bạn có thể tham khảo cách sử dụng cột phụ trong bảng giá như sau:
=INDEX($D$4:$I$19;MATCH($A25&$B25&D$24;$J$4:$J$19;0);MATCH($C25;$D$3:$I$3;0))
View attachment 299666
Em cảm ơn bác rất nhiều ạGóp vui.
@S.Ha tham khảo:
Lưu ý: Có thể code chỉ chạy cho ra kết quả đúng với dữ liệu trong file đính kèm.Mã:Option Explicit Sub HA() Dim i&, j&, lr&, t&, k& Dim Arr(), Arr1(), KQ() Dim Dic As Object, Key, Temp Dim Sh As Worksheet, Ws As Worksheet Dim Ten As String, LoaiDV As String, LoaiPT As String, NoiDungDV As String Application.ScreenUpdating = False Set Sh = Sheets("BangGia") lr = Sh.Cells(100000, 1).End(xlUp).Row Arr = Sh.Range("A3:I" & lr).Value Set Dic = CreateObject("Scripting.Dictionary") For i = 2 To UBound(Arr) For j = 4 To UBound(Arr, 2) Key = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3) & "|" & Arr(1, j) Dic(Key) = Arr(i, j) Next j Next i Set Ws = Sheets("Bang1") Arr1 = Ws.Range("A14: G" & Ws.Cells(100000, 1).End(xlUp).Row).Value ReDim KQ(1 To UBound(Arr1), 1 To 4) For i = 2 To UBound(Arr1) t = t + 1: k = 0 Ten = Arr1(i, 1) LoaiDV = Arr1(i, 2) LoaiPT = Arr1(i, 3) For j = 4 To UBound(Arr1, 2) NoiDungDV = Arr1(1, j): k = k + 1 Temp = Ten & "|" & LoaiDV & "|" & NoiDungDV & "|" & LoaiPT For Each Key In Dic.Keys If Key = Temp Then KQ(t, k) = Dic(Key): Exit For Next Key Next j Next i If t Then Ws.Range("D15").Resize(100000, 4).ClearContents Ws.Range("D15").Resize(t, 4) = KQ End If Set Dic = Nothing Application.ScreenUpdating = True MsgBox "Done" End Sub