Tính tỷ lệ sở hữu các cá nhân/pháp nhân trong Tập đoàn

Chia sẻ bởi:hands

★★★★★

‹ Chuyển mã Tiếng Việt, thay thế Unikey... Đóng toàn bộ ứng dụng và tắt... ›

Quảng cáo

Xin chào các bác, nay em có bài toán này nhờ các bác giải đáp giúp.

Em đang có trong file là 1 bảng cơ cấu vốn và 1 bảng tỷ lệ sở hữu, câu hỏi đặt ra là làm thế nào để tính nhanh tỷ lệ sở hữu của 1 cá nhân (hoặc công ty) trong 1 công ty bất kỳ mà không cần phải mò lần từng ô một.

Trong file em có:
– Hàng dọc là các công ty, hàng ngang là các chủ sở hữu tương ứng
– Bảng màu cam là số vốn của mỗi công ty và phần góp của mỗi chủ đầu tư, bảng màu xanh là tỷ lệ sở hữu tương ứng (công thức từ bảng cam)

Ví dụ để tính tỷ lệ sở hữu của Mr. A tại Công ty C:
– Tỷ lệ nắm giữ trực tiếp thông qua Công ty A: = D2*B5 (Mr.A nắm 8% ở Công ty A, Công ty A nắm 33% ở Công ty C => 8%*33% = 3%)
– Tỷ lệ nắm giữ gián tiếp thông qua Công ty A: = D3*C2*B5 (Mr.A nắm 8% ở Công ty A, Công ty A nắm 18% ở Công ty B, Công ty B nắm 50% ở Công ty C => 8%*18%*50% = 1%)
– Tỷ lệ nắm giữ trực tiếp thông qua Công ty B: = D3*C5 (Mr.A nắm 36% ở Công ty B, Công ty B nắm 50% ở Công ty C => 36%*50% = 18%)

==> Tổng cộng tỷ lệ của Mr. A tại Công ty C là 22% như trong file

428

Cách tính của bạn chưa tính đầy đủ tỷ lệ sở hữu khi có sở hữu chéo giữa các đơn vị, muốn tính đầy đủ làm theo cách bài 9# khá phức tạp
Tạm dùng hàm tự tạo TyleSH theo cách tính của bạn khá đơn giản, code cũng dể, nhưng tính bị thiếu khi có sở hữu chéo

Option Explicit
Function TyleSH(ByVal rng As Range, ByVal ChuSH, ByVal cTy, Optional bTyLe As Boolean = True)
  Dim dic As Object, arr(), i&, res#

Set dic = CreateObject("scripting.dictionary")
  If bTyLe = True Then arr = rng.Value Else arr = TinhTyLe(rng)

For i = 2 To UBound(arr)
    dic.Add arr(i, 1), i
  Next i
  Call DeQuy(res, arr, dic, cTy, ChuSH, "," & ChuSH & ",", 1)
  Set dic = Nothing: Set rng = Nothing
  TyleSH = res
End Function

Private Sub DeQuy(ByRef res, ByRef arr, ByRef dic, ByRef cTy, ByVal sh$, ByVal tmp$, ByVal tl#)
  Dim i&, j&
  i = dic.Item(sh)
  For j = 2 To UBound(arr, 2)
    If arr(i, j) <> Empty Then
      If cTy = arr(1, j) Then
        res = res + tl * arr(i, j)
      ElseIf InStr(1, tmp, "," & arr(1, j) & ",") = 0 Then
        Call DeQuy(res, arr, dic, cTy, arr(1, j), tmp & arr(1, j) & ",", tl * arr(i, j))
      End If
    End If
  Next j
End Sub

Private Function TinhTyLe(ByRef rng)
  Dim arr(), tmp(), sRow&, sCol&, i&, j&
  arr = rng.Value
  sRow = UBound(arr): sCol = UBound(arr, 2)
  ReDim tmp(1 To sRow, 1 To sCol)
  For j = 2 To sCol
    For i = 2 To sRow
      tmp(1, j) = tmp(1, j) + arr(i, j)
    Next i
    For i = 2 To sRow
      arr(i, j) = arr(i, j) / tmp(1, j)
    Next i
  Next j
  TinhTyLe = arr
End Function

Xem 2 cách dùng hàm trong file

www.giaiphapexcel.com/diendan/threads/t%C3%ADnh-t%E1%BB%B7-l%E1%BB%87-s%E1%BB%9F-h%E1%BB%AFu-c%C3%A1c-c%C3%A1-nh%C3%A2n-ph%C3%A1p-nh%C3%A2n-trong-t%E1%BA%ADp-%C4%91o%C3%A0n.159997/