Files
004_comission/jimmycheung93/task4/1/as_xlsx_helloworld_pivot.bas
louiscklaw 2e592cb561 update,
2025-01-31 21:36:48 +08:00

200 lines
6.1 KiB
QBasic

Attribute VB_Name = "as_xlsx_helloworld_pivot"
Option Explicit
' get the last row for a given xls sheet
Function getLastRow(ByVal start_row As Integer)
Dim last_row As Boolean
Dim last_check_row As Integer
Dim scan_row As Integer
Dim i As Integer
Dim cell_value_1 As String
Dim next_row_1 As Integer
scan_row = start_row
last_check_row = 9999
For i = start_row To last_check_row
scan_row = i
last_row = True
next_row_1 = i + 1
cell_value_1 = ReadCellValue("A" & CStr(next_row_1))
If (cell_value_1 <> "") Then
last_row = False
End If
If (last_row = True) Then
'Debug.Print "last row found"
Exit For
End If
Next i
getLastRow = scan_row
End Function
' get the value from cell for a given address
Function ReadCellValue(cell_addr As String)
ReadCellValue = Worksheets("Sheet1").Range(cell_addr).Value
End Function
' get the integer month from date
Function GetMonthFrDate(ByVal date_string As String) As Integer
Dim intMonth As Integer
Dim dt As String
dt = DateValue(date_string)
intMonth = month(dt)
GetMonthFrDate = intMonth
End Function
' get the integer quarter from date
Function GetQuarterFrDate(ByVal date_string As String) As Integer
Dim intQuarter As Integer
Dim intMonth As Integer
Dim dt As String
dt = DateValue(date_string)
intMonth = month(dt)
GetQuarterFrDate = Int((intMonth - 1) / 3) + 1
End Function
Function CountFigures(ws As Worksheet, ByVal start_row As Integer, ByVal last_row As Integer)
Dim SalesNewCaseByMonth As Integer
Dim SalesCollapsedCaseByMonth As Integer
Dim i, j As Integer
' variable for result
Dim monthly_total_sell, month_total_commission
Set monthly_total_sell = CreateObject("Scripting.Dictionary")
Set month_total_commission = CreateObject("Scripting.Dictionary")
Dim team_a_best, team_a_best_value, team_a_best_name, team_a_best_commission
Set team_a_best = CreateObject("Scripting.Dictionary")
Set team_a_best_value = CreateObject("Scripting.Dictionary")
Set team_a_best_name = CreateObject("Scripting.Dictionary")
Set team_a_best_commission = CreateObject("Scripting.Dictionary")
Dim team_b_best, team_b_best_value, team_b_best_name, team_b_best_commission
Set team_b_best = CreateObject("Scripting.Dictionary")
Set team_b_best_value = CreateObject("Scripting.Dictionary")
Set team_b_best_name = CreateObject("Scripting.Dictionary")
Set team_b_best_commission = CreateObject("Scripting.Dictionary")
For j = 1 To 12
team_a_best(CStr(j)) = 0
team_b_best(CStr(j)) = 0
Next j
For i = start_row To last_row
Dim date_value As String
Dim agent_name As String
Dim team As String
Dim temp_key As String
Dim selling_price, commision_pct, commision_value As Double
Dim int_month, int_quarter As Integer
date_value = ReadCellValue("B" & CStr(i))
int_month = GetMonthFrDate(date_value)
int_quarter = GetQuarterFrDate(date_value)
agent_name = ReadCellValue("C" & CStr(i))
team = ReadCellValue("D" & CStr(i))
selling_price = CDbl(ReadCellValue("E" & CStr(i)))
commision_pct = CDbl(ReadCellValue("F" & CStr(i)))
commision_value = selling_price * commision_pct
temp_key = agent_name & "," & int_month
' create if not found agent_name
If (Not (IsEmpty(temp_key)) And Not (monthly_total_sell.exists(temp_key))) Then
For j = 1 To 12
monthly_total_sell(agent_name + "," + CStr(j)) = 0
Next j
End If
monthly_total_sell(agent_name + "," + CStr(int_month)) = monthly_total_sell(agent_name + "," + CStr(int_month)) + selling_price
month_total_commission(agent_name + "," + CStr(int_month)) = month_total_commission(agent_name + "," + CStr(int_month)) + commision_value
' is in team A?
If (CheckSalesIsInTeamA(agent_name)) Then
If (monthly_total_sell(agent_name + "," + CStr(int_month)) > team_a_best(CStr(int_month))) Then
team_a_best_name(CStr(int_month)) = agent_name
team_a_best_value(CStr(int_month)) = monthly_total_sell(agent_name + "," + CStr(int_month))
team_a_best_commission(CStr(int_month)) = month_total_commission(agent_name + "," + CStr(int_month))
End If
End If
' is in team B?
If (CheckSalesIsInTeamB(agent_name)) Then
If (monthly_total_sell(agent_name + "," + CStr(int_month)) > team_b_best(CStr(int_month))) Then
team_b_best_name(CStr(int_month)) = agent_name
team_b_best_value(CStr(int_month)) = monthly_total_sell(agent_name + "," + CStr(int_month))
team_b_best_commission(CStr(int_month)) = month_total_commission(agent_name + "," + CStr(int_month))
End If
End If
Next i
CountFigures = Array(monthly_total_sell, _
team_a_best_name, _
team_a_best_value, _
team_a_best_commission, _
team_b_best_name, _
team_b_best_value, _
team_b_best_commission _
)
End Function
Function Run(ws As Worksheet)
Dim row_count As Integer
Dim rw As Variant
Dim count_figures_result As Variant
Dim start_row, last_row As Integer
start_row = 2
last_row = getLastRow(start_row)
count_figures_result = CountFigures(ws, start_row, last_row)
Run = count_figures_result
End Function
' canned method to open excel file
Function OpenFile(sPath As String)
Dim wb As Workbook
Set wb = Workbooks.Open(sPath)
Dim count_figures_result As Variant
If Not (wb.Sheets("Sheet1") Is Nothing) Then
count_figures_result = as_xlsx_helloworld_pivot.Run(wb.Sheets("Sheet1"))
End If
OpenFile = count_figures_result
wb.Close savechanges:=False
End Function
Sub Test()
Dim result As Variant
Dim result1
result = as_xlsx_helloworld_pivot.OpenFile("c:\Temp\xlsx\Agent_Sales.xlsx")
Set result1 = result(0)
Debug.Print "done"
End Sub
Sub Helloworld()
Debug.Print "helloworld"
End Sub