Trợ giúp Code VBA tìm kiếm và tính toán theo hai điều kiện

Liên hệ QC

hoahuongduong1986

Thành viên thường trực
Tham gia
14/11/18
Bài viết
346
Được thích
40
Kính gửi Anh chị trên Diễn đàn,
Em có File tính toán kèm theo ạ. Tại Sheet Saoke em muốn tính tổng điểm tại cột M theo hai điều kiện tìm kiếm ạ. Cột I đến L là số lượng và các tiêu đề "Số lượng đối tác, số lượng HS bàn giao, Số lượng KUNN, Số lượng tài sản" sẽ trùng về mặt ký tự tại cột D tại sheet Ma
Yêu cầu: Tính quy đổi điểm tại cột M như ví dụ em làm tại M2 theo hai điều kiện là Giao dich Sub và các tiêu đề "Số lượng đối tác, số lượng HS bàn giao, Số lượng KUNN, Số lượng tài sản" (Điểm quy đổi = Hệ số điểm trường bổ sung tại Cột E sheet Ma * Số lượng tại I,J, K, L tại Sheet Sao ke)
Kính nhờ sự trợ giúp của anh chi và các bạn !
 

File đính kèm

  • Tinh toan.xlsx
    217 KB · Đọc: 5
Kính gửi Anh chị trên Diễn đàn,
Em có File tính toán kèm theo ạ. Tại Sheet Saoke em muốn tính tổng điểm tại cột M theo hai điều kiện tìm kiếm ạ. Cột I đến L là số lượng và các tiêu đề "Số lượng đối tác, số lượng HS bàn giao, Số lượng KUNN, Số lượng tài sản" sẽ trùng về mặt ký tự tại cột D tại sheet Ma
Yêu cầu: Tính quy đổi điểm tại cột M như ví dụ em làm tại M2 theo hai điều kiện là Giao dich Sub và các tiêu đề "Số lượng đối tác, số lượng HS bàn giao, Số lượng KUNN, Số lượng tài sản" (Điểm quy đổi = Hệ số điểm trường bổ sung tại Cột E sheet Ma * Số lượng tại I,J, K, L tại Sheet Sao ke)
Kính nhờ sự trợ giúp của anh chi và các bạn !
1.Bạn có thể cho kết quả mẫu 16 dòng?

2.Dùng các hàm có sẵn của excel được không bạn?
 
Upvote 0
1.Bạn có thể cho kết quả mẫu 16 dòng?

2.Dùng các hàm có sẵn của excel được không bạn?
Thực ra dùng hàm được ạ. Nhưng Data của em có nhiều trường và nặng khoảng hơn 20MB nếu hàm vào nữa nó quá nặng anh.
Yêu cầu của em cụ thể là: Tại SHeet Saoke tính tại cột M với điều kiện tìm là Các tiêu chí tại cột B - Giao dich Sub và điều kiện thứ 2 là tại Cột I, J, K, L
Điểm đơn vị có tại Sheet Ma. Lấy điểm đơn vị nhân với số lượng thì ra tổng điểm.
 

File đính kèm

  • Tinh toan.xlsx
    218.6 KB · Đọc: 2
Upvote 0
Upvote 0
A xem giúp em sang Code ý tưởng này với ạ.
Thử chuyển sang code:
PHP:
Public Sub Test()
Dim Dic As Object
Dim i As Long, j As Long
Dim lr As Long, kd As Long
Dim a(), b(), c(), d(), e()
Dim temp As String
Set Dic = CreateObject("Scripting.Dictionary")

With Sheets("Ma")
lr = .Range("B" & Rows.Count).End(xlUp).Row
a = .Range("B2:E" & lr).Value
End With
For i = 1 To UBound(a)
    If a(i, 3) <> "" And a(i, 4) <> "" Then
        Dic.Item(a(i, 1) & "|" & a(i, 3)) = a(i, 4)
    End If
Next i

With Sheets("Saoke")
   lr = .Range("B" & Rows.Count).End(xlUp).Row
   b = .Range("B2:B" & lr).Value
   c = .Range("I2:L" & lr).Value
   lr = UBound(b, 1)
   ReDim e(1 To lr, 1 To 1)
   d = .Range("I1:L1").Value
   kd = UBound(d, 2)
End With

For i = 1 To lr
    For j = 1 To kd
        temp = b(i, 1) & "|" & d(1, j)
        If Dic.Exists(temp) Then
            If c(i, j) <> 0 Then
                e(i, 1) = c(i, j) * Dic.Item(temp)
                Exit For
            End If
        End If
    Next j
Next i
         
Sheets("Saoke").Range("M2").Resize(lr, 1) = e
End Sub
 
Upvote 0
Thử chuyển sang code:
PHP:
Public Sub Test()
Dim Dic As Object
Dim i As Long, j As Long
Dim lr As Long, kd As Long
Dim a(), b(), c(), d(), e()
Dim temp As String
Set Dic = CreateObject("Scripting.Dictionary")

With Sheets("Ma")
lr = .Range("B" & Rows.Count).End(xlUp).Row
a = .Range("B2:E" & lr).Value
End With
For i = 1 To UBound(a)
    If a(i, 3) <> "" And a(i, 4) <> "" Then
        Dic.Item(a(i, 1) & "|" & a(i, 3)) = a(i, 4)
    End If
Next i

With Sheets("Saoke")
   lr = .Range("B" & Rows.Count).End(xlUp).Row
   b = .Range("B2:B" & lr).Value
   c = .Range("I2:L" & lr).Value
   lr = UBound(b, 1)
   ReDim e(1 To lr, 1 To 1)
   d = .Range("I1:L1").Value
   kd = UBound(d, 2)
End With

For i = 1 To lr
    For j = 1 To kd
        temp = b(i, 1) & "|" & d(1, j)
        If Dic.Exists(temp) Then
            If c(i, j) <> 0 Then
                e(i, 1) = c(i, j) * Dic.Item(temp)
                Exit For
            End If
        End If
    Next j
Next i
        
Sheets("Saoke").Range("M2").Resize(lr, 1) = e
End Sub
Em cảm ơn sự trợ giúp nhiệt tình của anh ạ. Chúc a gặp nhiều may mắn!
 
Upvote 0
Web KT
Back
Top Bottom