Files
jimmycheung93/task4/1/NoOfCasesTable.bas
louiscklaw 1b62961605 update,
2025-02-01 02:02:37 +08:00

297 lines
8.7 KiB
QBasic

Attribute VB_Name = "NoOfCasesTable"
Function NoOfCasesTable_Calc(ByVal TablesMeta As Variant) As Variant
Debug.Print "helloworld"
Set new_case_per_agent = CreateObject("Scripting.Dictionary")
Set collapsed_case_per_agent = CreateObject("Scripting.Dictionary")
Set case_persistency_by_agent = CreateObject("Scripting.Dictionary")
Dim case_persistency_team_a As Double
Dim case_persistency_team_b As Double
'case_team_a_meta
Dim case_team_a_meta As Variant
Dim case_team_b_meta As Variant
Dim agent_sales_table As Variant
Dim product_sales_meta As Variant
Dim product_sales_table As Variant
Dim val_agent_name As String
Dim val_team As String
agent_sales_table = TablesMeta(0)
Dim agent_sales_table_rows As Variant
agent_sales_table_rows = agent_sales_table(0)
product_sales_table = TablesMeta(1)
Dim product_sales_table_row As Variant
product_sales_table_row = product_sales_table(0)
agent_working_performance_table = TablesMeta(2)
Dim agent_working_performance_table_rows As Variant
agent_working_performance_table_rows = agent_working_performance_table(0)
Dim val_product_sales_selling_unit As String
Dim sales_selling_unit_TA As Integer
Dim sales_selling_unit_TB As Integer
Dim team As String
For ps = 1 To agent_working_performance_table(1)
val_agent_name = agent_working_performance_table_rows(ps, 2)
val_team = agent_working_performance_table_rows(ps, 3)
num_new_case = agent_working_performance_table_rows(ps, 4)
num_collapsed_case = agent_working_performance_table_rows(ps, 5)
If (Not (IsEmpty(val_agent_name)) And Not (new_case_per_agent.exists(val_agent_name))) Then
new_case_per_agent(val_agent_name) = 0
End If
new_case_per_agent(val_agent_name) = new_case_per_agent(val_agent_name) + num_new_case
If (Not (IsEmpty(val_agent_name)) And Not (collapsed_case_per_agent.exists(val_agent_name))) Then
collapsed_case_per_agent(val_agent_name) = 0
End If
collapsed_case_per_agent(val_agent_name) = collapsed_case_per_agent(val_agent_name) + num_collapsed_case
If (val_team = "A") Then
new_case_team_a = new_case_team_a + num_new_case
collapsed_case_team_a = collapsed_case_team_a + num_collapsed_case
End If
If (val_team = "B") Then
new_case_team_b = new_case_team_b + num_new_case
collapsed_case_team_b = collapsed_case_team_b + num_collapsed_case
End If
Next ps
For s = 0 To UBound(SALES_ARRAY)
sales_name = SALES_ARRAY(s)
collapsed_case = collapsed_case_per_agent(sales_name)
new_case = new_case_per_agent(sales_name)
case_persistency_by_agent(sales_name) = (new_case - collapsed_case) / new_case
Next s
case_persistency_team_a = (new_case_team_a - collapsed_case_team_a) / new_case_team_a
case_persistency_team_b = (new_case_team_b - collapsed_case_team_b) / new_case_team_b
case_team_a_meta = Array(new_case_team_a, collapsed_case_team_a)
case_team_b_meta = Array(new_case_team_b, collapsed_case_team_b)
NoOfCasesTable_Calc = Array(1, sales_selling_unit_TA, sales_selling_unit_TB, case_persistency_team_a, case_persistency_team_b, case_team_a_meta, case_team_b_meta)
End Function
Function NoOfCasesTable_WriteTable(ByVal calc_result As Variant, ByVal file_path As String, ByRef wb As Workbook)
Dim sales_selling_unit_TA As Integer
Dim sales_selling_unit_TB As Integer
sales_selling_unit_TA = calc_result(1)
sales_selling_unit_TB = calc_result(2)
Dim case_persistency_team_a As Double
Dim case_persistency_team_b As Double
case_persistency_team_a = calc_result(3)
case_persistency_team_b = calc_result(4)
Const TOP_ROW As Long = 1
Dim ws As Worksheet
Dim startCell As Range
Dim tempArray() As Variant
Dim i As Long
' Check if the sheet exists
On Error Resume Next
Set ws = wb.Sheets("No. of cases")
On Error GoTo 0
' If not found, create a new sheet
If ws Is Nothing Then
Set ws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
ws.Name = "No. of cases"
Else
' Empty the entire sheet
ws.UsedRange.ClearContents
End If
' Write month names
Set startCell = ws.Range("A1")
tempArray = Array("Case Persistency")
For i = LBound(tempArray) To UBound(tempArray)
startCell.Offset(0, i).Value = tempArray(i)
Next i
' Write month names
Set startCell = ws.Range("A2")
tempArray = Array("Name", "No of new case", "No. of collpased case", "Case Persistency")
For i = LBound(tempArray) To UBound(tempArray)
startCell.Offset(0, i).Value = tempArray(i)
Next i
' Write month names
Set startCell = ws.Range("A3")
For i = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
startCell.Offset(i, 0).Value = SALES_ARRAY(i)
Next i
' Write month names
Set startCell = ws.Range("B3")
' For sales_name = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
For s = 0 To UBound(SALES_ARRAY)
sales_name = SALES_ARRAY(s)
startCell.Offset(s, 0).Value = new_case_per_agent(sales_name)
Next s
' Write month names
Set startCell = ws.Range("C3")
' For sales_name = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
For s = 0 To UBound(SALES_ARRAY)
sales_name = SALES_ARRAY(s)
startCell.Offset(s, 0).Value = collapsed_case_per_agent(sales_name)
Next s
' Write month names
Set startCell = ws.Range("D3")
' For sales_name = LBound(SALES_ARRAY) To UBound(SALES_ARRAY)
For s = 0 To UBound(SALES_ARRAY)
sales_name = SALES_ARRAY(s)
startCell.Offset(s, 0).Value = case_persistency_by_agent(sales_name)
startCell.Offset(s, 0).NumberFormat = "0.00%"
Next s
' Write month names
Set startCell = ws.Range("A14")
tempArray = Array("Team A total", "Team B Total")
For i = LBound(tempArray) To UBound(tempArray)
startCell.Offset(i, 0).Value = tempArray(i)
Next i
' Write month names
Set startCell = ws.Range("B14")
tempArray = Array("Team A total", "Team B Total")
startCell.Offset(0, 0).Value = new_case_team_a
startCell.Offset(1, 0).Value = new_case_team_b
' Write month names
Set startCell = ws.Range("C14")
tempArray = Array("Team A total", "Team B Total")
startCell.Offset(0, 0).Value = collapsed_case_team_a
startCell.Offset(1, 0).Value = collapsed_case_team_b
' Write month names
Set startCell = ws.Range("D14")
tempArray = Array("Team A total", "Team B Total")
startCell.Offset(0, 0).Value = case_persistency_team_a
startCell.Offset(1, 0).Value = case_persistency_team_b
startCell.Offset(0, 0).NumberFormat = "0.00%"
startCell.Offset(1, 0).NumberFormat = "0.00%"
' styling
Dim ranges_need_paint As Variant
For i = 0 To 100
ws.Range("A1").Offset(0, i).EntireColumn.AutoFit
Next i
For i = 0 To 3
Range("A1").Offset(0, i).EntireColumn.ColumnWidth = 20
Next i
ranges_need_paint = Array("A1")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(68, 114, 196)
.Font.Color = RGB(255, 255, 255)
End With
Next r
ranges_need_paint = Array("A2")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Font.Color = RGB(48, 84, 150)
End With
Next r
ranges_need_paint = Array("B2:C2")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Font.Color = RGB(48, 84, 150)
.Font.Bold = True
End With
Next r
ranges_need_paint = Array("D2")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Font.Color = RGB(0, 0, 0)
.Font.Bold = True
End With
Next r
ranges_need_paint = Array("A3:D3", "A5:D5", "A7:D7", "A9:D9", "A11:D11", "A13:D13", "A15:D15")
For r = LBound(ranges_need_paint) To UBound(ranges_need_paint)
range_need_merge = ranges_need_paint(r)
With Range(range_need_merge)
.Interior.Color = RGB(217, 225, 242)
End With
Next r
With Range("B2:D15")
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlHAlignCenter
End With
For Each r In Array("A2:D2", "A3:D15")
With Range(r).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range(r).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range(r).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Range(r).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Next r
End Function