Xin code function cho phương pháp Pro_rata

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
E chào cả nhà,

Hiện em đang làm tính weight cho một rổ cổ phiếu với cách tính Pro_rata. Em đính kèm file. Sheet TOP 40, cột K là cột e tính tay theo weight của cột G, nhưng sẽ có trương hợp sẽ phải Cap rất nhiều lần. Em muốn nhờ mọi người giúp em code VBA để vik function cho pro_rata này ạ.

Điều kiện không có cổ phiếu nào có tỷ trọng vượt quá 10%, tổng các tỷ trọng các cổ phiếu 100%. Nếu cổ phiếu nào vượt 10% thì phân bổ xuống các cổ phiếu có tỷ trọng < 10%.
Công thức:
- Nếu trên hoặc bằng 10% thì bằng 10%
- Nếu dưới 10% thì:
[(Tỷ trọng của cp hiện tại / Tổng tỷ trọng các cổ phiếu có tỷ trọng dưới 10%) * Phần tỷ trọng dư ra (của các cổ phiếu trên 10%)] + Tỷ trọng của cổ phiếu hiện tại

Trong trường hợp có thêm điều kiện về ngành là tổng tỷ trọng cp trong một ngành không quá 45% thì như thế nào ạ. E cám ơn ạ.
 

File đính kèm

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
Hoặc có code VBA nào xử lý được vấn đề này không ạ.
 

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,187
Được thích
11,494
Điểm
1,560
E chào cả nhà,

Hiện em đang làm tính weight cho một rổ cổ phiếu với cách tính Pro_rata. Em đính kèm file. Sheet TOP 40, cột K là cột e tính tay theo weight của cột G, nhưng sẽ có trương hợp sẽ phải Cap rất nhiều lần. Em muốn nhờ mọi người giúp em code VBA để vik function cho pro_rata này ạ.

Điều kiện không có cổ phiếu nào có tỷ trọng vượt quá 10%, tổng các tỷ trọng các cổ phiếu 100%. Nếu cổ phiếu nào vượt 10% thì phân bổ xuống các cổ phiếu có tỷ trọng < 10%.
Công thức:
- Nếu trên hoặc bằng 10% thì bằng 10%
- Nếu dưới 10% thì:
[(Tỷ trọng của cp hiện tại / Tổng tỷ trọng các cổ phiếu có tỷ trọng dưới 10%) * Phần tỷ trọng dư ra (của các cổ phiếu trên 10%)] + Tỷ trọng của cổ phiếu hiện tại

Trong trường hợp có thêm điều kiện về ngành là tổng tỷ trọng cp trong một ngành không quá 45% thì như thế nào ạ. E cám ơn ạ.
Bạn nên đưa cách tính và nhập kết quả tay mới hiểu được cách tính
 

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
Dạ, để em nói rõ hơn ạ.

Concept là lấy phần dư phân bổ lại cho các cổ phiếu có tỷ trọng dưới 10%

Explain.png
 

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
Trong trường hợp sẽ yêu cầu cap thêm điều kiện về ngành là không vượt quá 40%, kèm theo hai điều kiện phía trên là một cp không quá 10% và tổng cả rổ cp là 100%.

- Trường hợp này em sẽ cap cp về <=10%.
- Sau đó, cộng tỷ trọng các ngành lại, ngành nào quá 40% thi giảm pro-rata xuong các cổ phiếu trong ngành khác (cách giảm pro-rata tương tự phía trên ạ)
- Cổ phiếu nào đã 10% thì không được phân bổ nữa ạ
 

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,187
Được thích
11,494
Điểm
1,560
Trong trường hợp sẽ yêu cầu cap thêm điều kiện về ngành là không vượt quá 40%, kèm theo hai điều kiện phía trên là một cp không quá 10% và tổng cả rổ cp là 100%.

- Trường hợp này em sẽ cap cp về <=10%.
- Sau đó, cộng tỷ trọng các ngành lại, ngành nào quá 40% thi giảm pro-rata xuong các cổ phiếu trong ngành khác (cách giảm pro-rata tương tự phía trên ạ)
- Cổ phiếu nào đã 10% thì không được phân bổ nữa ạ
Giải thích chỉ có bạn hiểu
Tạo lại công thức mới
Hiện tại không có ngành nào >40%, tạm qui định mới định là >35% thì bạn sẽ làm như thế nào, cho ví dụ cụ thể
 

File đính kèm

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,187
Được thích
11,494
Điểm
1,560
Dạ, e làm các bước ví dụ để hiểu về cách phân bổ trong file excel e gửi kèm.
Đây là bài toán có khả năng thực hiện vô số bước và hội tụ về 1 kết quả, với cách làm từng bước nầy không khả thi, hên thì ra kết quả xui thì làm tới vô cực lần, bạn nên tìm phương án khác
Cách làm của bạn chắc chắn chạm ngưỡng 30%, nên qui định 29,99% hoặc thêm vài số 9
 
Lần chỉnh sửa cuối:

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
Nếu như theo cách làm từng bước em thực hiện trong excel và như anh nói, khả năng xảy ra lỗi rất cao và phải làm rất nhiều bước hên xui, nên em không biết có cách nào sử dụng VBA để hạn chế lỗi (giảm bớt human error)?
 

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,187
Được thích
11,494
Điểm
1,560
Nếu như theo cách làm từng bước em thực hiện trong excel và như anh nói, khả năng xảy ra lỗi rất cao và phải làm rất nhiều bước hên xui, nên em không biết có cách nào sử dụng VBA để hạn chế lỗi (giảm bớt human error)?
Chạy code theo trình tự xử lý:
- Điều chỉnh tỷ trọng ngành <30%
- Trong từng ngành chỉnh từng đơn vị <=10% với tỷ trọng ngành đã điều chỉnh
Mã:
Sub LamTuoiThamSo()
  Dim sArr(), aNganh(), aData(), Res(), Dic As Object, ikey
  Dim sRow&, sR&, i&, sCol&, iR&
  Dim tmp As Double, dc As Double
  Const ghNganh = 0.3
  Const ghNganh2 = 0.2999
  Const ghCT = 0.1
 
  With Sheets("Top40")
    sArr = .Range("E4", .Range("F" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 1)
  ReDim aNganh(-1 To sRow, 1 To 1)
  ReDim aData(0 To sRow, 1 To 1)
  Set Dic = CreateObject("scripting.dictionary")
  Dic.CompareMode = vbTextCompare
  For i = 1 To sRow
    ikey = sArr(i, 1)
    If Dic.exists(ikey) = False Then
      sCol = sCol + 1
      Dic.Add ikey, sCol
      ReDim Preserve aNganh(-1 To sRow, 1 To sCol)
      ReDim Preserve aData(0 To sRow, 1 To sCol)
    End If
    jC = Dic.Item(ikey)
    aNganh(-1, jC) = aNganh(-1, jC) + 1 'So dong
    aNganh(0, jC) = aNganh(0, jC) + sArr(i, 2) 'Tong nganh
    aNganh(aNganh(-1, jC), jC) = i
    aData(0, jC) = aData(0, jC) + sArr(i, 2) 'Tong nganh
    aData(aNganh(-1, jC), jC) = sArr(i, 2)
  Next i
  Do 'Chinh Nganh<30%
    tmp = 0: dc = 0
    For j = 1 To sCol
      If aNganh(0, j) > ghNganh Then
        dc = dc + aNganh(0, j) - ghNganh2
      Else
        tmp = tmp + aNganh(0, j)
      End If
    Next j
    If dc > 0 Then
      dc = dc / tmp
      For j = 1 To sCol
        If aNganh(0, j) > ghNganh Then
          aNganh(0, j) = ghNganh2
        Else
          aNganh(0, j) = aNganh(0, j) * (1 + dc)
        End If
      Next j
    End If
  Loop Until dc = 0
 
  For j = 1 To sCol 'Chinh tung cong ty trong tung nganh
    dc = aNganh(0, j) / aData(0, j)
    sR = aNganh(-1, j)
    For i = 1 To sR
      aData(i, j) = aData(i, j) * dc
    Next i
    Do
      tmp = 0: dc = 0
      For i = 1 To sR
        If aData(i, j) > ghCT Then
          dc = dc + aData(i, j) - ghCT
        Else
          tmp = tmp + aData(i, j)
        End If
      Next i
      If dc > 0 Then
        dc = dc / tmp
        For i = 1 To sR
          If aData(i, j) > ghCT Then
            aData(i, j) = ghCT
          Else
            aData(i, j) = aData(i, j) * (1 + dc)
          End If
        Next i
      End If
    Loop Until dc = 0
  Next j
  For j = 1 To sCol 'gan ket qua
    sR = aNganh(-1, j)
    For i = 1 To sR
      Res(aNganh(i, j), 1) = aData(i, j)
    Next i
  Next j
  Sheets("Top40").Range("G4").Resize(sRow) = Res
End Sub
 

File đính kèm

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
Chạy code theo trình tự xử lý:
- Điều chỉnh tỷ trọng ngành <30%
- Trong từng ngành chỉnh từng đơn vị <=10% với tỷ trọng ngành đã điều chỉnh
Mã:
Sub LamTuoiThamSo()
  Dim sArr(), aNganh(), aData(), Res(), Dic As Object, ikey
  Dim sRow&, sR&, i&, sCol&, iR&
  Dim tmp As Double, dc As Double
  Const ghNganh = 0.3
  Const ghNganh2 = 0.2999
  Const ghCT = 0.1
 
  With Sheets("Top40")
    sArr = .Range("E4", .Range("F" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 1)
  ReDim aNganh(-1 To sRow, 1 To 1)
  ReDim aData(0 To sRow, 1 To 1)
  Set Dic = CreateObject("scripting.dictionary")
  Dic.CompareMode = vbTextCompare
  For i = 1 To sRow
    ikey = sArr(i, 1)
    If Dic.exists(ikey) = False Then
      sCol = sCol + 1
      Dic.Add ikey, sCol
      ReDim Preserve aNganh(-1 To sRow, 1 To sCol)
      ReDim Preserve aData(0 To sRow, 1 To sCol)
    End If
    jC = Dic.Item(ikey)
    aNganh(-1, jC) = aNganh(-1, jC) + 1 'So dong
    aNganh(0, jC) = aNganh(0, jC) + sArr(i, 2) 'Tong nganh
    aNganh(aNganh(-1, jC), jC) = i
    aData(0, jC) = aData(0, jC) + sArr(i, 2) 'Tong nganh
    aData(aNganh(-1, jC), jC) = sArr(i, 2)
  Next i
  Do 'Chinh Nganh<30%
    tmp = 0: dc = 0
    For j = 1 To sCol
      If aNganh(0, j) > ghNganh Then
        dc = dc + aNganh(0, j) - ghNganh2
      Else
        tmp = tmp + aNganh(0, j)
      End If
    Next j
    If dc > 0 Then
      dc = dc / tmp
      For j = 1 To sCol
        If aNganh(0, j) > ghNganh Then
          aNganh(0, j) = ghNganh2
        Else
          aNganh(0, j) = aNganh(0, j) * (1 + dc)
        End If
      Next j
    End If
  Loop Until dc = 0
 
  For j = 1 To sCol 'Chinh tung cong ty trong tung nganh
    dc = aNganh(0, j) / aData(0, j)
    sR = aNganh(-1, j)
    For i = 1 To sR
      aData(i, j) = aData(i, j) * dc
    Next i
    Do
      tmp = 0: dc = 0
      For i = 1 To sR
        If aData(i, j) > ghCT Then
          dc = dc + aData(i, j) - ghCT
        Else
          tmp = tmp + aData(i, j)
        End If
      Next i
      If dc > 0 Then
        dc = dc / tmp
        For i = 1 To sR
          If aData(i, j) > ghCT Then
            aData(i, j) = ghCT
          Else
            aData(i, j) = aData(i, j) * (1 + dc)
          End If
        Next i
      End If
    Loop Until dc = 0
  Next j
  For j = 1 To sCol 'gan ket qua
    sR = aNganh(-1, j)
    For i = 1 To sR
      Res(aNganh(i, j), 1) = aData(i, j)
    Next i
  Next j
  Sheets("Top40").Range("G4").Resize(sRow) = Res
End Sub
E cám ơn anh ạ. E có một số thắc mắc sau:
1. Sum up weight sau chỉnh nó vẫn lệch 1 ít 100.006
2. Em test thử một số data khác với tùy chỉnh điều kiện: ĐK ngành là 0.4 và ĐK ticker là 0.15
Em không hiểu ghNganh2 tại sao sao ko bằng 0.4 luôn mà phải là 0.3999

Nó báo lỗi ở đoạn này "dc = dc / tmp --> không chia được cho 0"

If dc > 0 Then
dc = dc / tmp
For i = 1 To sR
If aData(i, j) > ghCT Then
aData(i, j) = ghCT
Else
aData(i, j) = aData(i, j) * (1 + dc)
End If
 

File đính kèm

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,187
Được thích
11,494
Điểm
1,560
E cám ơn anh ạ. E có một số thắc mắc sau:
1. Sum up weight sau chỉnh nó vẫn lệch 1 ít 100.006
2. Em test thử một số data khác với tùy chỉnh điều kiện: ĐK ngành là 0.4 và ĐK ticker là 0.15
Em không hiểu ghNganh2 tại sao sao ko bằng 0.4 luôn mà phải là 0.3999

Nó báo lỗi ở đoạn này "dc = dc / tmp --> không chia được cho 0"

If dc > 0 Then
dc = dc / tmp
For i = 1 To sR
If aData(i, j) > ghCT Then
aData(i, j) = ghCT
Else
aData(i, j) = aData(i, j) * (1 + dc)
End If
Do dữ liệu ban đầu tổng là 100.006 nên kết quả vẫn là 100.006
Chỉnh lệnh
dc = dc / tmp
Thành
If tmp > 0 Then dc = dc / tmp
 

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
E đã chỉnh code lại, nhưng đứng excel báo lỗi not responding, e để ý khi đổ data có nhiều mã có tỷ trọng cao nó hay đều bị lỗi này.

Trong trường hợp này là

1574147070658.png

Em cám ơn anh ạ
 

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,187
Được thích
11,494
Điểm
1,560
E đã chỉnh code lại, nhưng đứng excel báo lỗi not responding, e để ý khi đổ data có nhiều mã có tỷ trọng cao nó hay đều bị lỗi này.

Trong trường hợp này là

View attachment 228581

Em cám ơn anh ạ
Thông báo (không phải lỗi) not responding khi code dùng tài nguyên máy khá nhiều, vòng lập chạy nhiều lần không thoát được. Nếu code hoàn thành sẽ ra kết quả bình thường
Thêm bẫy lỗi điều kiện ngành, điều kiện công ty khó xảy ra không thỏa nên bỏ qua
Mã:
Sub LamTuoiThamSo()
  Dim sArr(), aNganh(), aData(), Res(), Dic As Object, ikey
  Dim sRow&, sR&, i&, sCol&, iR&
  Dim tmp As Double, dc As Double
  Const ghNganh = 0.4
  Const ghNganh2 = 0.3999
  Const ghCT = 0.15
 
  With Sheets("Top40")
    sArr = .Range("E4", .Range("F" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 1)
  ReDim aNganh(-1 To sRow, 1 To 1)
  ReDim aData(0 To sRow, 1 To 1)
  Set Dic = CreateObject("scripting.dictionary")
  Dic.CompareMode = vbTextCompare
  For i = 1 To sRow
    ikey = sArr(i, 1)
    If Dic.exists(ikey) = False Then
      sCol = sCol + 1
      Dic.Add ikey, sCol
      ReDim Preserve aNganh(-1 To sRow, 1 To sCol)
      ReDim Preserve aData(0 To sRow, 1 To sCol)
    End If
    jC = Dic.Item(ikey)
    aNganh(-1, jC) = aNganh(-1, jC) + 1 'So dong
    aNganh(0, jC) = aNganh(0, jC) + sArr(i, 2) 'Tong nganh
    aNganh(aNganh(-1, jC), jC) = i
    aData(0, jC) = aData(0, jC) + sArr(i, 2) 'Tong nganh
    aData(aNganh(-1, jC), jC) = sArr(i, 2)
    tmp = tmp + sArr(i, 2) 'Tong
  Next i
  If tmp > sCol * ghNganh2 Then 'Kiem tra Gioi han nganh
    MsgBox (" Gioi Han Nganh khong phu hop"): Exit Sub
  End If
  Do 'Chinh Nganh<30%
    tmp = 0: dc = 0
    For j = 1 To sCol
      If aNganh(0, j) > ghNganh Then
        dc = dc + aNganh(0, j) - ghNganh2
      Else
        tmp = tmp + aNganh(0, j)
      End If
    Next j
    If dc > 0 Then
      If tmp > 0 Then dc = dc / tmp
      For j = 1 To sCol
        If aNganh(0, j) > ghNganh Then
          aNganh(0, j) = ghNganh2
        Else
          aNganh(0, j) = aNganh(0, j) * (1 + dc)
        End If
      Next j
    End If
  Loop Until dc = 0
 
  For j = 1 To sCol 'Chinh tung cong ty trong tung nganh
    dc = aNganh(0, j) / aData(0, j)
    sR = aNganh(-1, j)
    For i = 1 To sR
      aData(i, j) = aData(i, j) * dc
    Next i
    Do
      tmp = 0: dc = 0
      For i = 1 To sR
        If aData(i, j) > ghCT Then
          dc = dc + aData(i, j) - ghCT
        Else
          tmp = tmp + aData(i, j)
        End If
      Next i
      If dc > 0 Then
        If tmp > 0 Then dc = dc / tmp
        For i = 1 To sR
          If aData(i, j) > ghCT Then
            aData(i, j) = ghCT
          Else
            aData(i, j) = aData(i, j) * (1 + dc)
          End If
        Next i
      End If
    Loop Until dc = 0
  Next j
  For j = 1 To sCol 'gan ket qua
    sR = aNganh(-1, j)
    For i = 1 To sR
      Res(aNganh(i, j), 1) = aData(i, j)
    Next i
  Next j
  Sheets("Top40").Range("G4").Resize(sRow) = Res
End Sub
 
Lần chỉnh sửa cuối:

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
Thông báo (không phải lỗi) not responding khi code dùng tài nguyên máy khá nhiều, vòng lập chạy nhiều lần không thoát được. Nếu code hoàn thành sẽ ra kết quả bình thường
Thêm bẫy lỗi điều kiện ngành, điều kiện công ty khó xảy ra không thỏa nên bỏ qua
Mã:
Sub LamTuoiThamSo()
  Dim sArr(), aNganh(), aData(), Res(), Dic As Object, ikey
  Dim sRow&, sR&, i&, sCol&, iR&
  Dim tmp As Double, dc As Double
  Const ghNganh = 0.4
  Const ghNganh2 = 0.3999
  Const ghCT = 0.15

  With Sheets("Top40")
    sArr = .Range("E4", .Range("F" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 1)
  ReDim aNganh(-1 To sRow, 1 To 1)
  ReDim aData(0 To sRow, 1 To 1)
  Set Dic = CreateObject("scripting.dictionary")
  Dic.CompareMode = vbTextCompare
  For i = 1 To sRow
    ikey = sArr(i, 1)
    If Dic.exists(ikey) = False Then
      sCol = sCol + 1
      Dic.Add ikey, sCol
      ReDim Preserve aNganh(-1 To sRow, 1 To sCol)
      ReDim Preserve aData(0 To sRow, 1 To sCol)
    End If
    jC = Dic.Item(ikey)
    aNganh(-1, jC) = aNganh(-1, jC) + 1 'So dong
    aNganh(0, jC) = aNganh(0, jC) + sArr(i, 2) 'Tong nganh
    aNganh(aNganh(-1, jC), jC) = i
    aData(0, jC) = aData(0, jC) + sArr(i, 2) 'Tong nganh
    aData(aNganh(-1, jC), jC) = sArr(i, 2)
    tmp = tmp + sArr(i, 2) 'Tong
  Next i
  If tmp > sCol * ghNganh2 Then 'Kiem tra Gioi han nganh
    MsgBox (" Gioi Han Nganh khong phu hop"): Exit Sub
  End If
  Do 'Chinh Nganh<30%
    tmp = 0: dc = 0
    For j = 1 To sCol
      If aNganh(0, j) > ghNganh Then
        dc = dc + aNganh(0, j) - ghNganh2
      Else
        tmp = tmp + aNganh(0, j)
      End If
    Next j
    If dc > 0 Then
      If tmp > 0 Then dc = dc / tmp
      For j = 1 To sCol
        If aNganh(0, j) > ghNganh Then
          aNganh(0, j) = ghNganh2
        Else
          aNganh(0, j) = aNganh(0, j) * (1 + dc)
        End If
      Next j
    End If
  Loop Until dc = 0

  For j = 1 To sCol 'Chinh tung cong ty trong tung nganh
    dc = aNganh(0, j) / aData(0, j)
    sR = aNganh(-1, j)
    For i = 1 To sR
      aData(i, j) = aData(i, j) * dc
    Next i
    Do
      tmp = 0: dc = 0
      For i = 1 To sR
        If aData(i, j) > ghCT Then
          dc = dc + aData(i, j) - ghCT
        Else
          tmp = tmp + aData(i, j)
        End If
      Next i
      If dc > 0 Then
        If tmp > 0 Then dc = dc / tmp
        For i = 1 To sR
          If aData(i, j) > ghCT Then
            aData(i, j) = ghCT
          Else
            aData(i, j) = aData(i, j) * (1 + dc)
          End If
        Next i
      End If
    Loop Until dc = 0
  Next j
  For j = 1 To sCol 'gan ket qua
    sR = aNganh(-1, j)
    For i = 1 To sR
      Res(aNganh(i, j), 1) = aData(i, j)
    Next i
  Next j
  Sheets("Top40").Range("G4").Resize(sRow) = Res
End Sub
Dạ, cho e hỏi thêm một xíu nữa ạ. Nếu trong trường hợp, không có điều kiện ngành, chỉ còn đk tỷ trọng 1 cp không vượt 10% và tổng tỷ trọng 100% thì mình chỉnh lệnh như thế nào ạ?
 

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
Nếu trong trường hợp, không có điều kiện ngành, chỉ còn đk tỷ trọng 1 cp không vượt 10% và tổng tỷ trọng 100%, em chỉnh phần

Sub LamTuoiThamSo()
Dim sArr(), aNganh(), aData(), Res(), Dic As Object, ikey
Dim sRow&, sR&, i&, sCol&, iR&
Dim tmp As Double, dc As Double
Const ghNganh = 1
Const ghNganh2 = 0.9999
Const ghCT = 0.1

Code cho ra kết quả, anh cho e hỏi cách phân bổ của anh được không ạ.

Theo như e check thì phần dư chỉ được phân bổ xuống cho hai ngành Real Estates và Consumer Staples, các mã 2 ngành Financials và Consumer Dis không được phân bổ. Nếu mình muốn phần dư phân bổ đều xuống hết cho các mã <10% thì khả thi ko anh ạ.

1574233329973.png
 

File đính kèm

Lần chỉnh sửa cuối:

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,187
Được thích
11,494
Điểm
1,560
Nếu trong trường hợp, không có điều kiện ngành, chỉ còn đk tỷ trọng 1 cp không vượt 10% và tổng tỷ trọng 100%, em chỉnh phần

Sub LamTuoiThamSo()
Dim sArr(), aNganh(), aData(), Res(), Dic As Object, ikey
Dim sRow&, sR&, i&, sCol&, iR&
Dim tmp As Double, dc As Double
Const ghNganh = 1
Const ghNganh2 = 0.9999
Const ghCT = 0.1

Code cho ra kết quả, anh cho e hỏi cách phân bổ của anh được không ạ.

Theo như e check thì phần dư chỉ được phân bổ xuống cho hai ngành Real Estates và Consumer Staples, các mã 2 ngành Financials và Consumer Dis không được phân bổ. Nếu mình muốn phần dư phân bổ đều xuống hết cho các mã <10% thì khả thi ko anh ạ.

View attachment 228664
Chỉnh lệnh
ikey = sArr(i, 1)
thành
If ghNganh = 1 Then ikey = "1" Else ikey = sArr(i, 1)
 

Anne_1991

Thành viên mới
Tham gia ngày
11 Tháng mười một 2019
Bài viết
14
Được thích
1
Điểm
15
Tuổi
28
Dạ, em làm được rồi, cám ơn anh nhiều ạ. Chúc anh thật nhiều sức khỏe.
 
Top Bottom