Nhờ các bạn viết giúp code phép tính

[hiénlinh197]

Nhờ các bạn viết giúp code phép tính như trong file đính kèm.
Xin trân thành cảm ơn các bạn!

 

[HieuCD]

Nhờ các bạn viết giúp code phép tính như trong file đính kèm.
Xin trân thành cảm ơn các bạn!

Chạy code

Sub NhanMang()

  Dim sArr(), dArr(), Res()

  Dim i As Long

  Const dk = "A2:C5"

  Const dl = "E2:V6"

  Const kq = "E9"

  sArr = Range(dk).Value

  dArr = Range(dl).Value

  If UBound(sArr) <> UBound(dArr) - 1 Then MsgBox ("só dong khong phu hop"): Exit Sub

  ReDim Res(1 To UBound(sArr) * (UBound(sArr, 2) + 1) - 1, 1 To UBound(dArr, 2))

  For i = 1 To UBound(sArr)

    For j = 1 To UBound(sArr, 2)

      k = k + 1

      For n = 1 To UBound(dArr, 2)

        If TypeName(dArr(i, n)) = "Double" Then Res(k, n) = sArr(i, j) + dArr(i, n) * dArr(i + 1, n)

      Next n

    Next j

    k = k + 1

  Next i

  Range(kq).Resize(UBound(Res), UBound(Res, 2)) = Res

End Sub

 

[hiénlinh197]

Chạy code

Sub NhanMang()

  Dim sArr(), dArr(), Res()

  Dim i As Long

  Const dk = "A2:C5"

  Const dl = "E2:V6"

  Const kq = "E9"

  sArr = Range(dk).Value

  dArr = Range(dl).Value

  If UBound(sArr) <> UBound(dArr) - 1 Then MsgBox ("só dong khong phu hop"): Exit Sub

  ReDim Res(1 To UBound(sArr) * (UBound(sArr, 2) + 1) - 1, 1 To UBound(dArr, 2))

  For i = 1 To UBound(sArr)

    For j = 1 To UBound(sArr, 2)

      k = k + 1

      For n = 1 To UBound(dArr, 2)

        If TypeName(dArr(i, n)) = "Double" Then Res(k, n) = sArr(i, j) + dArr(i, n) * dArr(i + 1, n)

      Next n

    Next j

    k = k + 1

  Next i

  Range(kq).Resize(UBound(Res), UBound(Res, 2)) = Res

End Sub

Cảm ơn anh @Hieu CD rất nhiều, kết quả rất đúng. Ai có cách làm khác cách này của anh @HieuCD không nhỉ? Giúp mình với nhé!