004_comission/natalie0312
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

update,

Browse Source
This commit is contained in:
louiscklaw
2025-02-01 02:04:23 +08:00
parent 3de8aea20a
commit ec32653f3a
108 changed files with 12611 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
task4/.editorconfig Normal file
View File

@@ -0,0 +1,12 @@
# EditorConfig is awesome: https://EditorConfig.org
# top-most EditorConfig file
root = true
[*]
indent_style = space
indent_size = 4
end_of_line = lf
charset = latin1
trim_trailing_whitespace = true
insert_final_newline = true

BIN
task4/dist/Expense_Report.xlsm vendored Normal file
View File

Binary file not shown.

BIN
task4/dist/step.png (Stored with Git LFS) vendored Normal file
View File

Binary file not shown.

BIN
task4/from_client/Expense Report_original.xlsx Normal file
View File

Binary file not shown.

0
task4/notes.md Normal file
View File

BIN
task4/source/_del/Expense_Report_draft_001.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_draft_002.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_error.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_trunk - draft003.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_trunk - draft004.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_trunk - draft005.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_trunk - fast_draft001.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_trunk copy.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_trunk.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_trunk_o.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/_del/Expense_Report_working.xlsm Normal file
View File

Binary file not shown.

874
task4/source/_del/Module1.bas Normal file
View File

@@ -0,0 +1,874 @@
Attribute VB_Name = "Module1"
Option Explicit
Global I_TABLE_WIDTH As Integer
Global I_TABLE_HEIGHT As Integer
Global WS_RAW_DATA As String
Global WS_REQUIREMENTS As String
Global WS_CASE1 As String
Global WS_CASE2 As String
Global WS_CASE3 As String
Global WS_CASE4 As String
Global AA_RAW_DATA(30000) As Variant
Global A_RAW_DATA(99) As String
Global len_raw_data As Integer
Global temp_ws_case1(30000) As Variant
Global len_temp_ws_case1 As Integer
Global temp_ws_case2(30000) As Variant
Global len_temp_ws_case2 As Integer
Global temp_ws_case3(30000) As Variant
Global len_temp_ws_case3 As Integer
Global temp_ws_case4(30000) As Variant
Global len_temp_ws_case4 As Integer
Global temp_row(99) As String
Global COL_O_EXPENSE_NUMBER As Integer
Global COL_O_CLAIMANT_NAME As Integer
Global COL_O_REPORT_SUBMITTED_DATE As Integer
Global COL_O_EXPENSE_REPORT_DATE As Integer
Global COL_O_PURPOSE_1 As Integer
Global COL_O_PURPOSE_2 As Integer
Global COL_O_STATUS As Integer
Global COL_O_AMOUNT_HKD As Integer
Global COL_O_CURRENCY As Integer
Global COL_O_LINE_NUMBER As Integer
Global COL_O_EXPENSE_TYPE As Integer
Global COL_O_LINE_AMOUNT_HKD As Integer
Global COL_O_RECEIPT_AMOUNT_BEFORE_TAX As Integer
Global COL_O_LINE_CURRENCY As Integer
Global COL_O_EXCHANGE_RATE As Integer
Global COL_O_JUSTIFICATION As Integer
Global COL_O_EXPENSE_DATE As Integer
Global COL_O_ALLOCATION_NUMBER As Integer
Global COL_O_ALLOCATION_AMOUNT As Integer
Global COL_O_EXPENSE_ALLOCATION As Integer
Global COL_O_EMPLOYEE_IF_NOT_THE_CLAIMS As Integer
Global COL_O_DEPARTURE_LOCATION As Integer
Global COL_O_DESTINATION As Integer
Global COL_O_MODE_OF_TRANSPORTATION As Integer
Global COL_O_PURPOSE_OF_JOURNEY As Integer
Global COL_O_NAME_OF_GUEST_COMPANY As Integer
Global COL_O_MOST_SENIOR_PARTICIPANT As Integer
Global COL_O_PURPOSE_OF_ENTERTAINMENT As Integer
Global COL_O_COST_PER_HEAD As Integer
Global COL_O_COST_PER_HEAD_BEFORE_TAX As Integer
Global COL_O_NUMBER_OF_PARTICIPANTS As Integer
Global COL_O_NAME_AND_POSITION_OF_PARTICIPANTS As Integer
Global COL_O_TAR_APPROVED_NUMBER As Integer
Global COL_O_REASON_OF_GUEST_NO_DIFF As Integer
Global COL_O_REASON_OF_OTHER_RELATED_EXPENSE As Integer
Global COL_O_ABC_APPROVAL_REFERENCE_NUMBER As Integer
Global COL_O_ADDITIONAL_APPROVER_1 As Integer
Global COL_O_ADDITIONAL_APPROVER_2 As Integer
Global COL_O_EAP_APPROVER_3 As Integer
Global COL_O_ADDITIONAL_APPROVER_4 As Integer
Global COL_O_ADDITIONAL_APPROVER_5 As Integer
Global COL_O_ADDITIONAL_APPROVER_CEO As Integer
Global COL_O_ADDITIONAL_APPROVER_AAE As Integer
Global COL_O_HR_DIVISION_1 As Integer
Global COL_O_HR_DIVISION_2 As Integer
Global COL_O_HR_DIVISION_3 As Integer
Global COL_O_HR_DIVISION_4 As Integer
Sub initConfig()
COL_O_EXPENSE_NUMBER = 0
COL_O_CLAIMANT_NAME = 1
COL_O_REPORT_SUBMITTED_DATE = 2
COL_O_EXPENSE_REPORT_DATE = 3
COL_O_PURPOSE_1 = 4
COL_O_PURPOSE_2 = 5
COL_O_STATUS = 6
COL_O_AMOUNT_HKD = 7
COL_O_CURRENCY = 8
COL_O_LINE_NUMBER = 9
COL_O_EXPENSE_TYPE = 10
COL_O_LINE_AMOUNT_HKD = 11
COL_O_RECEIPT_AMOUNT_BEFORE_TAX = 12
COL_O_LINE_CURRENCY = 13
COL_O_EXCHANGE_RATE = 14
COL_O_JUSTIFICATION = 15
COL_O_EXPENSE_DATE = 16
COL_O_ALLOCATION_NUMBER = 17
COL_O_ALLOCATION_AMOUNT = 18
COL_O_EXPENSE_ALLOCATION = 19
COL_O_EMPLOYEE_IF_NOT_THE_CLAIMS = 20
COL_O_DEPARTURE_LOCATION = 21
COL_O_DESTINATION = 22
COL_O_MODE_OF_TRANSPORTATION = 23
COL_O_PURPOSE_OF_JOURNEY = 24
COL_O_NAME_OF_GUEST_COMPANY = 25
COL_O_MOST_SENIOR_PARTICIPANT = 26
COL_O_PURPOSE_OF_ENTERTAINMENT = 27
COL_O_COST_PER_HEAD = 28
COL_O_COST_PER_HEAD_BEFORE_TAX = 29
COL_O_NUMBER_OF_PARTICIPANTS = 30
COL_O_NAME_AND_POSITION_OF_PARTICIPANTS = 31
COL_O_TAR_APPROVED_NUMBER = 32
COL_O_REASON_OF_GUEST_NO_DIFF = 33
COL_O_REASON_OF_OTHER_RELATED_EXPENSE = 34
COL_O_ABC_APPROVAL_REFERENCE_NUMBER = 35
COL_O_ADDITIONAL_APPROVER_1 = 36
COL_O_ADDITIONAL_APPROVER_2 = 37
COL_O_EAP_APPROVER_3 = 38
COL_O_ADDITIONAL_APPROVER_4 = 39
COL_O_ADDITIONAL_APPROVER_5 = 40
COL_O_ADDITIONAL_APPROVER_CEO = 41
COL_O_ADDITIONAL_APPROVER_AAE = 42
COL_O_HR_DIVISION_1 = 43
COL_O_HR_DIVISION_2 = 44
COL_O_HR_DIVISION_3 = 45
COL_O_HR_DIVISION_4 = 46
WS_CASE1 = "Date & Amount"
WS_CASE2 = "Date & Amount & Type"
WS_CASE3 = "Date & Amount & Type & Name"
WS_CASE4 = "Professional Fees"
WS_RAW_DATA = "Raw Data"
WS_REQUIREMENTS = "Requirement"
I_TABLE_WIDTH = 99
I_TABLE_HEIGHT = 30000
len_temp_ws_case1 = 0
len_temp_ws_case2 = 0
len_temp_ws_case3 = 0
len_temp_ws_case4 = 0
End Sub
Function CheckWsExist(ws_string)
Dim output As Boolean
On Error GoTo eh
Dim i As Integer
For i = 1 To Worksheets.Count
If (Worksheets.Item(i).Name = ws_string) Then
CheckWsExist = True
Exit Function
End If
Next i
Done:
CheckWsExist = False
Exit Function
eh:
CheckWsExist = False
End Function
Sub CreateWsIfNotExist(ws_string)
If (CheckWsExist(ws_string) = False) Then
Dim newSheet As Worksheet
' Create a new worksheet and assign it to the variable
Set newSheet = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
' Optionally, you can name the new worksheet
newSheet.Name = ws_string
End If
End Sub
Function checkTableLength(ws_string)
Dim output As Integer
Dim r, c As Integer
For r = 1 To I_TABLE_HEIGHT
Dim temp As String
temp = Worksheets(ws_string).Range("A1").Offset(r, 0).Value
If temp = "" Then
output = r
Exit For
End If
Next r
checkTableLength = output - 1 '- 1 for header
End Function
Sub CopyRow(src_row, dst_list)
Dim r, c As Integer
End Sub
Sub CopyRowOriginal(src_sheet, src_row, dst_sheet, dst_row)
Dim r, c As Integer
For c = 0 To I_TABLE_WIDTH
Worksheets(dst_sheet).Range("A1").Offset(dst_row, c).Value = Worksheets(src_sheet).Range("A1").Offset(src_row, c).Value
If (dst_row <> 0) Then
Select Case c
Case COL_O_LINE_AMOUNT_HKD
Range("A1").Offset(dst_row, c).NumberFormat = "0.00"
Case COL_O_EXPENSE_DATE
Worksheets(dst_sheet).Range("A1").Offset(dst_row, c).Value = "'" & Worksheets(src_sheet).Range("A1").Offset(src_row, c).Value
Case Else
Debug.Print c
End Select
End If
Next c
End Sub
' Case 1
' Situation:
' > If any rows (with different expense number) of both Expense Date (Column Q) and Line Amount (Column L) have the same value
' 1. with different expense number (Column A)
' 2. Expense Date (Column Q) have the same value
' 3. Line Amount (Column L) have the same value
' Action:
' Create a tab (Name: Date & Amount) and copy and paste the related rows to this tab
Sub Case1()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase1()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE1)
Worksheets(WS_CASE1).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE1).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase1Original(src_wk_sheet, src_row, dst_wk_sheet, dst_row)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE, R_SAME_CLAIMANT_NAME As Boolean
output = True
R_DIFF_EXPENSE_NUM = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_EXPENSE_NUMBER).Value <> Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_EXPENSE_NUMBER).Value
R_SAME_EXPENSE_DATE = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_EXPENSE_DATE).Value = Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_EXPENSE_DATE).Value
R_SAME_LINE_AMOUNT = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_LINE_AMOUNT_HKD).Value = Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_LINE_AMOUNT_HKD).Value
R_SAME_EXPENSE_TYPE = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_EXPENSE_TYPE).Value = Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_EXPENSE_TYPE).Value
R_SAME_CLAIMANT_NAME = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_CLAIMANT_NAME).Value = Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_CLAIMANT_NAME).Value
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And Not (R_SAME_EXPENSE_TYPE Or R_SAME_CLAIMANT_NAME)
Debug.Print R_DIFF_EXPENSE_NUM
CheckFullfillCase1 = output
End Function
Function CheckFullfillCase1(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE, R_SAME_CLAIMANT_NAME As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row1(COL_O_EXPENSE_DATE) = row2(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row1(COL_O_LINE_AMOUNT_HKD) = row2(COL_O_LINE_AMOUNT_HKD)
'
R_SAME_EXPENSE_TYPE = row1(COL_O_EXPENSE_TYPE) = row2(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And Not (R_SAME_EXPENSE_TYPE Or R_SAME_CLAIMANT_NAME)
' Debug.Print R_DIFF_EXPENSE_NUM
Debug.Print "Helloworld"
CheckFullfillCase1 = output
End Function
Function CheckOccurInCase1(row_to_check)
Dim output As Boolean
output = False
Dim r, case1_table_len As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
For r = 0 To len_temp_ws_case1 - 1
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case1(r)(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row_to_check(COL_O_EXPENSE_DATE) = temp_ws_case1(r)(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row_to_check(COL_O_LINE_AMOUNT_HKD) = temp_ws_case1(r)(COL_O_LINE_AMOUNT_HKD)
If (R_SAME_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT) Then
output = True
Exit For
End If
Next r
CheckOccurInCase1 = output
End Function
Sub ProcessCase1()
initSheetForCase1
Dim r, r_c1 As Integer
Dim r_fullfill_case1 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case1 = CheckFullfillCase1(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case1) Then
If (CheckOccurInCase1(AA_RAW_DATA(r))) Then
' if occur in ws_case1, do nothing
Else
temp_ws_case1(len_temp_ws_case1) = AA_RAW_DATA(r)
len_temp_ws_case1 = len_temp_ws_case1 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
End If
If (CheckOccurInCase1(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case1, do nothing
Else
temp_ws_case1(len_temp_ws_case1) = AA_RAW_DATA(r_c1)
len_temp_ws_case1 = len_temp_ws_case1 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case1 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE1).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case1(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE1).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE1).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
' Case 2
' Situation:
' > If any rows (with different expense number) of Expense Date (Column Q), Line Amount (Column L) and Expense Type (Column K) have the same value
' 1. with different expense number (Column A)
' 2. Expense Date (Column Q) have the same value
' 3. Line Amount (Column L) have the same value
' 4. Expense Type (Column K) have the same value
' Action:
' Create a tab (Name: Date & Amount & Type) and copy and paste the related rows to this tab
Sub Case2()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase2()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE2)
Worksheets(WS_CASE2).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE2).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase2(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
Dim R_SAME_CLAIMANT_NAME, R_EXPENSE_TYPE_PROF_FEE As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row1(COL_O_EXPENSE_DATE) = row2(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row1(COL_O_LINE_AMOUNT_HKD) = row2(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row1(COL_O_EXPENSE_TYPE) = row2(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
R_EXPENSE_TYPE_PROF_FEE = row1(COL_O_EXPENSE_TYPE) = "PROF.FEE"
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE And Not (R_SAME_CLAIMANT_NAME Or R_EXPENSE_TYPE_PROF_FEE)
CheckFullfillCase2 = output
End Function
Function CheckOccurInCase2(row_to_check)
Dim output As Boolean
output = False
Dim r, case2_table_len As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
For r = 1 To len_temp_ws_case2 - 1
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case2(r)(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row_to_check(COL_O_EXPENSE_DATE) = temp_ws_case2(r)(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row_to_check(COL_O_LINE_AMOUNT_HKD) = temp_ws_case2(r)(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row_to_check(COL_O_EXPENSE_TYPE) = temp_ws_case2(r)(COL_O_EXPENSE_TYPE)
If (R_SAME_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE) Then
output = True
Exit For
End If
Next r
CheckOccurInCase2 = output
End Function
Sub ProcessCase2()
initSheetForCase2
Dim r, r_c1 As Integer
Dim r_fullfill_case2 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case2 = CheckFullfillCase2(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case2) Then
If (CheckOccurInCase2(AA_RAW_DATA(r))) Then
' if occur in ws_case2, do nothing
Else
temp_ws_case2(len_temp_ws_case2) = AA_RAW_DATA(r)
len_temp_ws_case2 = len_temp_ws_case2 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
End If
If (CheckOccurInCase2(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case2, do nothing
Else
temp_ws_case2(len_temp_ws_case2) = AA_RAW_DATA(r_c1)
len_temp_ws_case2 = len_temp_ws_case2 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case2 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE2).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case2(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE2).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE2).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
' Case 3
' Situation:
' > If any rows (with different expense number) of Expense Date (Column Q), Line Amount (Column L), Expense Type (Column K) and Claimant Name (Column B) have the same value
' 1. with different expense number (Column A)
' 2. Expense Date (Column Q) have the same value
' 3. Line Amount (Column L) have the same value
' 4. Expense Type (Column K) have the same value
' 5. Claimant Name (Column B) have the same value
' Action:
' Create a tab (Name: Date & Amount & Type & Name) and copy and paste the related rows to this tab
Sub Case3()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase3()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE3)
Worksheets(WS_CASE3).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE3).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase3(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
Dim R_EXPENSE_TYPE_PROF_FEE As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row1(COL_O_EXPENSE_DATE) = row2(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row1(COL_O_LINE_AMOUNT_HKD) = row2(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row1(COL_O_EXPENSE_TYPE) = row2(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
'
R_EXPENSE_TYPE_PROF_FEE = row1(COL_O_EXPENSE_TYPE) = "PROF.FEE"
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE And R_SAME_CLAIMANT_NAME And Not (R_EXPENSE_TYPE_PROF_FEE)
Debug.Print R_DIFF_EXPENSE_NUM
CheckFullfillCase3 = output
End Function
Function CheckOccurInCase3(row_to_check)
Dim output As Boolean
output = False
Dim r As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
For r = 0 To len_temp_ws_case3 - 1
R_SAME_EXPENSE_DATE = row_to_check(COL_O_EXPENSE_DATE) = temp_ws_case3(r)(COL_O_EXPENSE_DATE)
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case3(r)(COL_O_EXPENSE_NUMBER)
R_SAME_LINE_AMOUNT = row_to_check(COL_O_LINE_AMOUNT_HKD) = temp_ws_case3(r)(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row_to_check(COL_O_EXPENSE_TYPE) = temp_ws_case3(r)(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row_to_check(COL_O_CLAIMANT_NAME) = temp_ws_case3(r)(COL_O_CLAIMANT_NAME)
If (R_SAME_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE And R_SAME_CLAIMANT_NAME) Then
output = True
Exit For
End If
Next r
CheckOccurInCase3 = output
End Function
Sub ProcessCase3()
initSheetForCase3
Dim r, r_c1 As Integer
Dim r_fullfill_case3 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case3 = CheckFullfillCase3(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case3) Then
If (CheckOccurInCase3(AA_RAW_DATA(r))) Then
' if occur in ws_case3, do nothing
Else
temp_ws_case3(len_temp_ws_case3) = AA_RAW_DATA(r)
len_temp_ws_case3 = len_temp_ws_case3 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_CLAIMANT_NAME).Interior.Color = GetRandomColor
End If
If (CheckOccurInCase3(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case3, do nothing
Else
temp_ws_case3(len_temp_ws_case3) = AA_RAW_DATA(r_c1)
len_temp_ws_case3 = len_temp_ws_case3 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_CLAIMANT_NAME).Interior.Color = GetRandomColor
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case3 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE3).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case3(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE3).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE3).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
' Case 4
' Situation:
' > If Expense Type (Column K) contains PROF.FEE, and; If any rows (with different expense number) of Claimant Name (Column B) have the same value
' 1. If Expense Type (Column K) contains PROF.FEE
' 2. with different expense number (Column A)
' 3. Claimant Name (Column B) have the same value)
' Action:
' Create a tab (Name: Professional Fees) and copy and paste the related rows to this tab
Sub Case4()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase4()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE4)
Worksheets(WS_CASE4).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE4).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase4(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_EXPENSE_TYPE_PROF_FEE As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_EXPENSE_TYPE_PROF_FEE = row1(COL_O_EXPENSE_TYPE) = "PROF.FEE"
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
output = R_DIFF_EXPENSE_NUM And R_EXPENSE_TYPE_PROF_FEE And R_SAME_CLAIMANT_NAME
CheckFullfillCase4 = output
End Function
Function CheckOccurInCase4(row_to_check)
Dim output As Boolean
output = False
Dim r As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
For r = 0 To len_temp_ws_case4 - 1
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case4(r)(COL_O_EXPENSE_NUMBER)
R_SAME_CLAIMANT_NAME = row_to_check(COL_O_CLAIMANT_NAME) = temp_ws_case4(r)(COL_O_CLAIMANT_NAME)
If (R_SAME_EXPENSE_NUM And R_SAME_CLAIMANT_NAME) Then
output = True
Exit For
End If
Next r
CheckOccurInCase4 = output
End Function
Sub ProcessCase4()
initSheetForCase4
Dim r, r_c1 As Integer
Dim r_fullfill_case4 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case4 = CheckFullfillCase4(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case4) Then
If (CheckOccurInCase4(AA_RAW_DATA(r))) Then
' if occur in ws_case4, do nothing
Else
temp_ws_case4(len_temp_ws_case4) = AA_RAW_DATA(r)
len_temp_ws_case4 = len_temp_ws_case4 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_CLAIMANT_NAME).Interior.Color = GetRandomColor
End If
If (CheckOccurInCase4(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case4, do nothing
Else
temp_ws_case4(len_temp_ws_case4) = AA_RAW_DATA(r_c1)
len_temp_ws_case4 = len_temp_ws_case4 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_CLAIMANT_NAME).Interior.Color = GetRandomColor
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case4 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE4).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case4(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE4).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE4).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
Sub ReadRawData()
Dim r, i, j, k As Integer
len_raw_data = checkTableLength(WS_RAW_DATA)
For r = 1 To len_raw_data
Dim test(99) As String
For i = 0 To 99
test(i) = Worksheets(WS_RAW_DATA).Range("A1").Offset(r, i).Value
Next i
AA_RAW_DATA(r - 1) = test
Next r
End Sub
Sub TestMain()
initConfig
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ResetWs
ReadRawData
ProcessCase4
ProcessCase3
ProcessCase2
ProcessCase1
' Worksheets(WS_REQUIREMENTS).Activate
MsgBox "done"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub ResetWs()
Dim i, j As Integer
Dim last_sheet_idx As Integer
last_sheet_idx = Worksheets.Count
For i = 1 To last_sheet_idx
j = last_sheet_idx + 1 - i
Dim IsWsRawData As Boolean
Dim IsWsRequirements As Boolean
Dim IsWsDebug as Boolean
IsWsRawData = Worksheets.Item(j).Name = WS_RAW_DATA
IsWsRequirements = Worksheets.Item(j).Name = WS_REQUIREMENTS
IsWsDebug = Worksheets.item(j).Name = "debug"
If (IsWsRawData Or IsWsRequirements) Then
Else
Worksheets.Item(j).Delete
End If
Next
Dim r, table_length As Integer
table_length = checkTableLength(WS_RAW_DATA)
For r = 1 To table_length + 10
Worksheets(WS_RAW_DATA).Range("A1:Z" & CStr(table_length + 10)).Offset(r, 0).Interior.Color = xlNone
Next r
End Sub
Function GetRandomColor()
Dim randR As Integer
Dim randG As Integer
Dim randB As Integer
Randomize
randR = Int((256) * Rnd)
randG = Int((256) * Rnd)
randB = Int((256) * Rnd)
GetRandomColor = RGB(246, 229, 141)
End Function

879
task4/source/_del/Module1_orginal.bas Normal file
View File

@@ -0,0 +1,879 @@
Attribute VB_Name = "Module1"
Option Explicit
Global I_TABLE_WIDTH As Integer
Global I_TABLE_HEIGHT As Integer
Global WS_RAW_DATA As String
Global WS_REQUIREMENTS As String
Global WS_CASE1 As String
Global WS_CASE2 As String
Global WS_CASE3 As String
Global WS_CASE4 As String
Global AA_RAW_DATA(30000) As Variant
Global A_RAW_DATA(99) As String
Global len_raw_data As Integer
Global temp_ws_case1(30000) As Variant
Global len_temp_ws_case1 As Integer
Global temp_ws_case2(30000) As Variant
Global len_temp_ws_case2 As Integer
Global temp_ws_case3(30000) As Variant
Global len_temp_ws_case3 As Integer
Global temp_ws_case4(30000) As Variant
Global len_temp_ws_case4 As Integer
Global temp_row(99) As String
Global COL_O_EXPENSE_NUMBER As Integer
Global COL_O_CLAIMANT_NAME As Integer
Global COL_O_REPORT_SUBMITTED_DATE As Integer
Global COL_O_EXPENSE_REPORT_DATE As Integer
Global COL_O_PURPOSE_1 As Integer
Global COL_O_PURPOSE_2 As Integer
Global COL_O_STATUS As Integer
Global COL_O_AMOUNT_HKD As Integer
Global COL_O_CURRENCY As Integer
Global COL_O_LINE_NUMBER As Integer
Global COL_O_EXPENSE_TYPE As Integer
Global COL_O_LINE_AMOUNT_HKD As Integer
Global COL_O_RECEIPT_AMOUNT_BEFORE_TAX As Integer
Global COL_O_LINE_CURRENCY As Integer
Global COL_O_EXCHANGE_RATE As Integer
Global COL_O_JUSTIFICATION As Integer
Global COL_O_EXPENSE_DATE As Integer
Global COL_O_ALLOCATION_NUMBER As Integer
Global COL_O_ALLOCATION_AMOUNT As Integer
Global COL_O_EXPENSE_ALLOCATION As Integer
Global COL_O_EMPLOYEE_IF_NOT_THE_CLAIMS As Integer
Global COL_O_DEPARTURE_LOCATION As Integer
Global COL_O_DESTINATION As Integer
Global COL_O_MODE_OF_TRANSPORTATION As Integer
Global COL_O_PURPOSE_OF_JOURNEY As Integer
Global COL_O_NAME_OF_GUEST_COMPANY As Integer
Global COL_O_MOST_SENIOR_PARTICIPANT As Integer
Global COL_O_PURPOSE_OF_ENTERTAINMENT As Integer
Global COL_O_COST_PER_HEAD As Integer
Global COL_O_COST_PER_HEAD_BEFORE_TAX As Integer
Global COL_O_NUMBER_OF_PARTICIPANTS As Integer
Global COL_O_NAME_AND_POSITION_OF_PARTICIPANTS As Integer
Global COL_O_TAR_APPROVED_NUMBER As Integer
Global COL_O_REASON_OF_GUEST_NO_DIFF As Integer
Global COL_O_REASON_OF_OTHER_RELATED_EXPENSE As Integer
Global COL_O_ABC_APPROVAL_REFERENCE_NUMBER As Integer
Global COL_O_ADDITIONAL_APPROVER_1 As Integer
Global COL_O_ADDITIONAL_APPROVER_2 As Integer
Global COL_O_EAP_APPROVER_3 As Integer
Global COL_O_ADDITIONAL_APPROVER_4 As Integer
Global COL_O_ADDITIONAL_APPROVER_5 As Integer
Global COL_O_ADDITIONAL_APPROVER_CEO As Integer
Global COL_O_ADDITIONAL_APPROVER_AAE As Integer
Global COL_O_HR_DIVISION_1 As Integer
Global COL_O_HR_DIVISION_2 As Integer
Global COL_O_HR_DIVISION_3 As Integer
Global COL_O_HR_DIVISION_4 As Integer
Sub initConfig()
COL_O_EXPENSE_NUMBER = 0
COL_O_CLAIMANT_NAME = 1
COL_O_REPORT_SUBMITTED_DATE = 2
COL_O_EXPENSE_REPORT_DATE = 3
COL_O_PURPOSE_1 = 4
COL_O_PURPOSE_2 = 5
COL_O_STATUS = 6
COL_O_AMOUNT_HKD = 7
COL_O_CURRENCY = 8
COL_O_LINE_NUMBER = 9
COL_O_EXPENSE_TYPE = 10
COL_O_LINE_AMOUNT_HKD = 11
COL_O_RECEIPT_AMOUNT_BEFORE_TAX = 12
COL_O_LINE_CURRENCY = 13
COL_O_EXCHANGE_RATE = 14
COL_O_JUSTIFICATION = 15
COL_O_EXPENSE_DATE = 16
COL_O_ALLOCATION_NUMBER = 17
COL_O_ALLOCATION_AMOUNT = 18
COL_O_EXPENSE_ALLOCATION = 19
COL_O_EMPLOYEE_IF_NOT_THE_CLAIMS = 20
COL_O_DEPARTURE_LOCATION = 21
COL_O_DESTINATION = 22
COL_O_MODE_OF_TRANSPORTATION = 23
COL_O_PURPOSE_OF_JOURNEY = 24
COL_O_NAME_OF_GUEST_COMPANY = 25
COL_O_MOST_SENIOR_PARTICIPANT = 26
COL_O_PURPOSE_OF_ENTERTAINMENT = 27
COL_O_COST_PER_HEAD = 28
COL_O_COST_PER_HEAD_BEFORE_TAX = 29
COL_O_NUMBER_OF_PARTICIPANTS = 30
COL_O_NAME_AND_POSITION_OF_PARTICIPANTS = 31
COL_O_TAR_APPROVED_NUMBER = 32
COL_O_REASON_OF_GUEST_NO_DIFF = 33
COL_O_REASON_OF_OTHER_RELATED_EXPENSE = 34
COL_O_ABC_APPROVAL_REFERENCE_NUMBER = 35
COL_O_ADDITIONAL_APPROVER_1 = 36
COL_O_ADDITIONAL_APPROVER_2 = 37
COL_O_EAP_APPROVER_3 = 38
COL_O_ADDITIONAL_APPROVER_4 = 39
COL_O_ADDITIONAL_APPROVER_5 = 40
COL_O_ADDITIONAL_APPROVER_CEO = 41
COL_O_ADDITIONAL_APPROVER_AAE = 42
COL_O_HR_DIVISION_1 = 43
COL_O_HR_DIVISION_2 = 44
COL_O_HR_DIVISION_3 = 45
COL_O_HR_DIVISION_4 = 46
WS_CASE1 = "Date & Amount"
WS_CASE2 = "Date & Amount & Type"
WS_CASE3 = "Date & Amount & Type & Name"
WS_CASE4 = "Professional Fees"
WS_RAW_DATA = "Raw Data"
WS_REQUIREMENTS = "Requirement"
I_TABLE_WIDTH = 99
I_TABLE_HEIGHT = 30000
len_temp_ws_case1 = 0
len_temp_ws_case2 = 0
len_temp_ws_case3 = 0
len_temp_ws_case4 = 0
End Sub
Function CheckWsExist(ws_string)
Dim output As Boolean
On Error GoTo eh
Dim i As Integer
For i = 1 To Worksheets.Count
If (Worksheets.Item(i).Name = ws_string) Then
CheckWsExist = True
Exit Function
End If
Next i
Done:
CheckWsExist = False
Exit Function
eh:
CheckWsExist = False
End Function
Sub CreateWsIfNotExist(ws_string)
If (CheckWsExist(ws_string) = False) Then
Dim newSheet As Worksheet
' Create a new worksheet and assign it to the variable
Set newSheet = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
' Optionally, you can name the new worksheet
newSheet.Name = ws_string
End If
End Sub
Function checkTableLength(ws_string)
Dim output As Integer
Dim r, c As Integer
For r = 1 To I_TABLE_HEIGHT
Dim temp As String
temp = Worksheets(ws_string).Range("A1").Offset(r, 0).Value
If temp = "" Then
output = r
Exit For
End If
Next r
checkTableLength = output - 1 '- 1 for header
End Function
Sub CopyRow(src_row, dst_list)
Dim r, c As Integer
End Sub
Sub CopyRowOriginal(src_sheet, src_row, dst_sheet, dst_row)
Dim r, c As Integer
For c = 0 To I_TABLE_WIDTH
Worksheets(dst_sheet).Range("A1").Offset(dst_row, c).Value = Worksheets(src_sheet).Range("A1").Offset(src_row, c).Value
If (dst_row <> 0) Then
Select Case c
Case COL_O_LINE_AMOUNT_HKD
Range("A1").Offset(dst_row, c).NumberFormat = "0.00"
Case COL_O_EXPENSE_DATE
Worksheets(dst_sheet).Range("A1").Offset(dst_row, c).Value = "'" & Worksheets(src_sheet).Range("A1").Offset(src_row, c).Value
Case Else
Debug.Print c
End Select
End If
Next c
End Sub
' Case 1
' Situation:
' > If any rows (with different expense number) of both Expense Date (Column Q) and Line Amount (Column L) have the same value
' 1. with different expense number (Column A)
' 2. Expense Date (Column Q) have the same value
' 3. Line Amount (Column L) have the same value
' Action:
' Create a tab (Name: Date & Amount) and copy and paste the related rows to this tab
Sub Case1()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase1()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE1)
Worksheets(WS_CASE1).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE1).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase1Original(src_wk_sheet, src_row, dst_wk_sheet, dst_row)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE, R_SAME_CLAIMANT_NAME As Boolean
output = True
R_DIFF_EXPENSE_NUM = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_EXPENSE_NUMBER).Value <> Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_EXPENSE_NUMBER).Value
R_SAME_EXPENSE_DATE = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_EXPENSE_DATE).Value = Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_EXPENSE_DATE).Value
R_SAME_LINE_AMOUNT = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_LINE_AMOUNT_HKD).Value = Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_LINE_AMOUNT_HKD).Value
R_SAME_EXPENSE_TYPE = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_EXPENSE_TYPE).Value = Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_EXPENSE_TYPE).Value
R_SAME_CLAIMANT_NAME = Worksheets(src_wk_sheet).Range("A1").Offset(src_row, COL_O_CLAIMANT_NAME).Value = Worksheets(dst_wk_sheet).Range("A1").Offset(dst_row, COL_O_CLAIMANT_NAME).Value
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And Not (R_SAME_EXPENSE_TYPE Or R_SAME_CLAIMANT_NAME)
Debug.Print R_DIFF_EXPENSE_NUM
CheckFullfillCase1 = output
End Function
Function CheckFullfillCase1(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE, R_SAME_CLAIMANT_NAME As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row1(COL_O_EXPENSE_DATE) = row2(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row1(COL_O_LINE_AMOUNT_HKD) = row2(COL_O_LINE_AMOUNT_HKD)
'
R_SAME_EXPENSE_TYPE = row1(COL_O_EXPENSE_TYPE) = row2(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And Not (R_SAME_EXPENSE_TYPE Or R_SAME_CLAIMANT_NAME)
' Debug.Print R_DIFF_EXPENSE_NUM
Debug.Print "Helloworld"
CheckFullfillCase1 = output
End Function
Function CheckOccurInCase1(row_to_check)
Dim output As Boolean
output = False
Dim r, case1_table_len As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
For r = 0 To len_temp_ws_case1 - 1
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case1(r)(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row_to_check(COL_O_EXPENSE_DATE) = temp_ws_case1(r)(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row_to_check(COL_O_LINE_AMOUNT_HKD) = temp_ws_case1(r)(COL_O_LINE_AMOUNT_HKD)
If (R_SAME_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT) Then
output = True
Exit For
End If
Next r
CheckOccurInCase1 = output
End Function
Sub ProcessCase1()
initSheetForCase1
Dim r, r_c1 As Integer
Dim r_fullfill_case1 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case1 = CheckFullfillCase1(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case1) Then
highlight= GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_DATE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_DATE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = highlight
If (CheckOccurInCase1(AA_RAW_DATA(r))) Then
' if occur in ws_case1, do nothing
Else
temp_ws_case1(len_temp_ws_case1) = AA_RAW_DATA(r)
len_temp_ws_case1 = len_temp_ws_case1 + 1
End If
If (CheckOccurInCase1(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case1, do nothing
Else
temp_ws_case1(len_temp_ws_case1) = AA_RAW_DATA(r_c1)
len_temp_ws_case1 = len_temp_ws_case1 + 1
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case1 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE1).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case1(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE1).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE1).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
' Case 2
' Situation:
' > If any rows (with different expense number) of Expense Date (Column Q), Line Amount (Column L) and Expense Type (Column K) have the same value
' 1. with different expense number (Column A)
' 2. Expense Date (Column Q) have the same value
' 3. Line Amount (Column L) have the same value
' 4. Expense Type (Column K) have the same value
' Action:
' Create a tab (Name: Date & Amount & Type) and copy and paste the related rows to this tab
Sub Case2()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase2()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE2)
Worksheets(WS_CASE2).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE2).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase2(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
Dim R_SAME_CLAIMANT_NAME, R_EXPENSE_TYPE_PROF_FEE As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row1(COL_O_EXPENSE_DATE) = row2(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row1(COL_O_LINE_AMOUNT_HKD) = row2(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row1(COL_O_EXPENSE_TYPE) = row2(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
R_EXPENSE_TYPE_PROF_FEE = row1(COL_O_EXPENSE_TYPE) = "PROF.FEE"
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE And Not (R_SAME_CLAIMANT_NAME Or R_EXPENSE_TYPE_PROF_FEE)
CheckFullfillCase2 = output
End Function
Function CheckOccurInCase2(row_to_check)
Dim output As Boolean
output = False
Dim r, case2_table_len As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
For r = 1 To len_temp_ws_case2 - 1
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case2(r)(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row_to_check(COL_O_EXPENSE_DATE) = temp_ws_case2(r)(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row_to_check(COL_O_LINE_AMOUNT_HKD) = temp_ws_case2(r)(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row_to_check(COL_O_EXPENSE_TYPE) = temp_ws_case2(r)(COL_O_EXPENSE_TYPE)
If (R_SAME_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE) Then
output = True
Exit For
End If
Next r
CheckOccurInCase2 = output
End Function
Sub ProcessCase2()
initSheetForCase2
Dim r, r_c1 As Integer
Dim r_fullfill_case2 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case2 = CheckFullfillCase2(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case2) Then
highlight= GetRandomColor
If (CheckOccurInCase2(AA_RAW_DATA(r))) Then
' if occur in ws_case2, do nothing
Else
temp_ws_case2(len_temp_ws_case2) = AA_RAW_DATA(r)
len_temp_ws_case2 = len_temp_ws_case2 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_DATE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_TYPE).Interior.Color = highlight
End If
If (CheckOccurInCase2(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case2, do nothing
Else
temp_ws_case2(len_temp_ws_case2) = AA_RAW_DATA(r_c1)
len_temp_ws_case2 = len_temp_ws_case2 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_DATE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_TYPE).Interior.Color = highlight
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case2 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE2).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case2(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE2).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE2).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
' Case 3
' Situation:
' > If any rows (with different expense number) of Expense Date (Column Q), Line Amount (Column L), Expense Type (Column K) and Claimant Name (Column B) have the same value
' 1. with different expense number (Column A)
' 2. Expense Date (Column Q) have the same value
' 3. Line Amount (Column L) have the same value
' 4. Expense Type (Column K) have the same value
' 5. Claimant Name (Column B) have the same value
' Action:
' Create a tab (Name: Date & Amount & Type & Name) and copy and paste the related rows to this tab
Sub Case3()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase3()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE3)
Worksheets(WS_CASE3).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE3).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase3(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
Dim R_EXPENSE_TYPE_PROF_FEE As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row1(COL_O_EXPENSE_DATE) = row2(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row1(COL_O_LINE_AMOUNT_HKD) = row2(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row1(COL_O_EXPENSE_TYPE) = row2(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
'
R_EXPENSE_TYPE_PROF_FEE = row1(COL_O_EXPENSE_TYPE) = "PROF.FEE"
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE And R_SAME_CLAIMANT_NAME And Not (R_EXPENSE_TYPE_PROF_FEE)
Debug.Print R_DIFF_EXPENSE_NUM
CheckFullfillCase3 = output
End Function
Function CheckOccurInCase3(row_to_check)
Dim output As Boolean
output = False
Dim r As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
For r = 0 To len_temp_ws_case3 - 1
R_SAME_EXPENSE_DATE = row_to_check(COL_O_EXPENSE_DATE) = temp_ws_case3(r)(COL_O_EXPENSE_DATE)
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case3(r)(COL_O_EXPENSE_NUMBER)
R_SAME_LINE_AMOUNT = row_to_check(COL_O_LINE_AMOUNT_HKD) = temp_ws_case3(r)(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row_to_check(COL_O_EXPENSE_TYPE) = temp_ws_case3(r)(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row_to_check(COL_O_CLAIMANT_NAME) = temp_ws_case3(r)(COL_O_CLAIMANT_NAME)
If (R_SAME_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE And R_SAME_CLAIMANT_NAME) Then
output = True
Exit For
End If
Next r
CheckOccurInCase3 = output
End Function
Sub ProcessCase3()
initSheetForCase3
Dim r, r_c1 As Integer
Dim r_fullfill_case3 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case3 = CheckFullfillCase3(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case3) Then
highlight= GetRandomColor
If (CheckOccurInCase3(AA_RAW_DATA(r))) Then
' if occur in ws_case3, do nothing
Else
temp_ws_case3(len_temp_ws_case3) = AA_RAW_DATA(r)
len_temp_ws_case3 = len_temp_ws_case3 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_DATE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_TYPE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_CLAIMANT_NAME).Interior.Color = highlight
End If
If (CheckOccurInCase3(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case3, do nothing
Else
temp_ws_case3(len_temp_ws_case3) = AA_RAW_DATA(r_c1)
len_temp_ws_case3 = len_temp_ws_case3 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_DATE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_TYPE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_CLAIMANT_NAME).Interior.Color = highlight
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case3 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE3).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case3(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE3).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE3).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
' Case 4
' Situation:
' > If Expense Type (Column K) contains PROF.FEE, and; If any rows (with different expense number) of Claimant Name (Column B) have the same value
' 1. If Expense Type (Column K) contains PROF.FEE
' 2. with different expense number (Column A)
' 3. Claimant Name (Column B) have the same value)
' Action:
' Create a tab (Name: Professional Fees) and copy and paste the related rows to this tab
Sub Case4()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase4()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE4)
Worksheets(WS_CASE4).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE4).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase4(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_EXPENSE_TYPE_PROF_FEE As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_EXPENSE_TYPE_PROF_FEE = row1(COL_O_EXPENSE_TYPE) = "PROF.FEE"
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
output = R_DIFF_EXPENSE_NUM And R_EXPENSE_TYPE_PROF_FEE And R_SAME_CLAIMANT_NAME
CheckFullfillCase4 = output
End Function
Function CheckOccurInCase4(row_to_check)
Dim output As Boolean
output = False
Dim r As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
For r = 0 To len_temp_ws_case4 - 1
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case4(r)(COL_O_EXPENSE_NUMBER)
R_SAME_CLAIMANT_NAME = row_to_check(COL_O_CLAIMANT_NAME) = temp_ws_case4(r)(COL_O_CLAIMANT_NAME)
If (R_SAME_EXPENSE_NUM And R_SAME_CLAIMANT_NAME) Then
output = True
Exit For
End If
Next r
CheckOccurInCase4 = output
End Function
Sub ProcessCase4()
initSheetForCase4
Dim r, r_c1 As Integer
Dim r_fullfill_case4 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case4 = CheckFullfillCase4(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case4) Then
highlight= GetRandomColor
If (CheckOccurInCase4(AA_RAW_DATA(r))) Then
' if occur in ws_case4, do nothing
Else
temp_ws_case4(len_temp_ws_case4) = AA_RAW_DATA(r)
len_temp_ws_case4 = len_temp_ws_case4 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_TYPE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_CLAIMANT_NAME).Interior.Color = highlight
End If
If (CheckOccurInCase4(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case4, do nothing
Else
temp_ws_case4(len_temp_ws_case4) = AA_RAW_DATA(r_c1)
len_temp_ws_case4 = len_temp_ws_case4 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_TYPE).Interior.Color = highlight
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_CLAIMANT_NAME).Interior.Color = highlight
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case4 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE4).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case4(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE4).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE4).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
Sub ReadRawData()
Dim r, i, j, k As Integer
len_raw_data = checkTableLength(WS_RAW_DATA)
For r = 1 To len_raw_data
Dim test(99) As String
For i = 0 To 99
test(i) = Worksheets(WS_RAW_DATA).Range("A1").Offset(r, i).Value
Next i
AA_RAW_DATA(r - 1) = test
Next r
End Sub
Sub TestMain()
initConfig
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ResetWs
ReadRawData
' ProcessCase4
' ProcessCase3
' ProcessCase2
ProcessCase1
' Worksheets(WS_REQUIREMENTS).Activate
MsgBox "done"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub ResetWs()
Dim i, j As Integer
Dim last_sheet_idx As Integer
last_sheet_idx = Worksheets.Count
For i = 1 To last_sheet_idx
j = last_sheet_idx + 1 - i
Dim IsWsRawData As Boolean
Dim IsWsRequirements As Boolean
IsWsRawData = Worksheets.Item(j).Name = WS_RAW_DATA
IsWsRequirements = Worksheets.Item(j).Name = WS_REQUIREMENTS
If (IsWsRawData Or IsWsRequirements) Then
Else
Worksheets.Item(j).Delete
End If
Next
Dim r, table_length As Integer
table_length = checkTableLength(WS_RAW_DATA)
For r = 1 To table_length + 10
Worksheets(WS_RAW_DATA).Range("A1:Z" & CStr(table_length + 10)).Offset(r, 0).Interior.Color = xlNone
Next r
End Sub
Function GetRandomColor()
Dim randR As Integer
Dim randG As Integer
Dim randB As Integer
Randomize
randR = Int((256) * Rnd)
randG = Int((256) * Rnd)
randB = Int((256) * Rnd)
GetRandomColor = RGB(246, 229, 141)
End Function

3
task4/source/dev.bat Normal file
View File

@@ -0,0 +1,3 @@
del Module1.bas
xlwings vba edit --file .\slow\Expense_Report_trunk.xlsm

BIN
task4/source/fast/Expense_Report_trunk_f.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/slow/Expense_Report_trunk.xlsm Normal file
View File

Binary file not shown.

BIN
task4/source/slow/Expense_Report_trunk_working.xlsm Normal file
View File

Binary file not shown.

804
task4/source/slow/Module1.bas Normal file
View File

@@ -0,0 +1,804 @@
Attribute VB_Name = "Module1"
Option Explicit
Global I_TABLE_WIDTH As Integer
Global I_TABLE_HEIGHT As Integer
Global WS_RAW_DATA As String
Global WS_REQUIREMENTS As String
Global WS_CASE1 As String
Global WS_CASE2 As String
Global WS_CASE3 As String
Global WS_CASE4 As String
Global AA_RAW_DATA(30000) As Variant
Global A_RAW_DATA(99) As String
Global len_raw_data As Integer
Global temp_ws_case1(30000) As Variant
Global len_temp_ws_case1 As Integer
Global temp_ws_case2(30000) As Variant
Global len_temp_ws_case2 As Integer
Global temp_ws_case3(30000) As Variant
Global len_temp_ws_case3 As Integer
Global temp_ws_case4(30000) As Variant
Global len_temp_ws_case4 As Integer
Global temp_row(99) As String
Global COL_O_EXPENSE_NUMBER As Integer
Global COL_O_CLAIMANT_NAME As Integer
Global COL_O_REPORT_SUBMITTED_DATE As Integer
Global COL_O_EXPENSE_REPORT_DATE As Integer
Global COL_O_PURPOSE_1 As Integer
Global COL_O_PURPOSE_2 As Integer
Global COL_O_STATUS As Integer
Global COL_O_AMOUNT_HKD As Integer
Global COL_O_CURRENCY As Integer
Global COL_O_LINE_NUMBER As Integer
Global COL_O_EXPENSE_TYPE As Integer
Global COL_O_LINE_AMOUNT_HKD As Integer
Global COL_O_RECEIPT_AMOUNT_BEFORE_TAX As Integer
Global COL_O_LINE_CURRENCY As Integer
Global COL_O_EXCHANGE_RATE As Integer
Global COL_O_JUSTIFICATION As Integer
Global COL_O_EXPENSE_DATE As Integer
Global COL_O_ALLOCATION_NUMBER As Integer
Global COL_O_ALLOCATION_AMOUNT As Integer
Global COL_O_EXPENSE_ALLOCATION As Integer
Global COL_O_EMPLOYEE_IF_NOT_THE_CLAIMS As Integer
Global COL_O_DEPARTURE_LOCATION As Integer
Global COL_O_DESTINATION As Integer
Global COL_O_MODE_OF_TRANSPORTATION As Integer
Global COL_O_PURPOSE_OF_JOURNEY As Integer
Global COL_O_NAME_OF_GUEST_COMPANY As Integer
Global COL_O_MOST_SENIOR_PARTICIPANT As Integer
Global COL_O_PURPOSE_OF_ENTERTAINMENT As Integer
Global COL_O_COST_PER_HEAD As Integer
Global COL_O_COST_PER_HEAD_BEFORE_TAX As Integer
Global COL_O_NUMBER_OF_PARTICIPANTS As Integer
Global COL_O_NAME_AND_POSITION_OF_PARTICIPANTS As Integer
Global COL_O_TAR_APPROVED_NUMBER As Integer
Global COL_O_REASON_OF_GUEST_NO_DIFF As Integer
Global COL_O_REASON_OF_OTHER_RELATED_EXPENSE As Integer
Global COL_O_ABC_APPROVAL_REFERENCE_NUMBER As Integer
Global COL_O_ADDITIONAL_APPROVER_1 As Integer
Global COL_O_ADDITIONAL_APPROVER_2 As Integer
Global COL_O_EAP_APPROVER_3 As Integer
Global COL_O_ADDITIONAL_APPROVER_4 As Integer
Global COL_O_ADDITIONAL_APPROVER_5 As Integer
Global COL_O_ADDITIONAL_APPROVER_CEO As Integer
Global COL_O_ADDITIONAL_APPROVER_AAE As Integer
Global COL_O_HR_DIVISION_1 As Integer
Global COL_O_HR_DIVISION_2 As Integer
Global COL_O_HR_DIVISION_3 As Integer
Global COL_O_HR_DIVISION_4 As Integer
Sub initConfig()
COL_O_EXPENSE_NUMBER = 0
COL_O_CLAIMANT_NAME = 1
COL_O_REPORT_SUBMITTED_DATE = 2
COL_O_EXPENSE_REPORT_DATE = 3
COL_O_PURPOSE_1 = 4
COL_O_PURPOSE_2 = 5
COL_O_STATUS = 6
COL_O_AMOUNT_HKD = 7
COL_O_CURRENCY = 8
COL_O_LINE_NUMBER = 9
COL_O_EXPENSE_TYPE = 10
COL_O_LINE_AMOUNT_HKD = 11
COL_O_RECEIPT_AMOUNT_BEFORE_TAX = 12
COL_O_LINE_CURRENCY = 13
COL_O_EXCHANGE_RATE = 14
COL_O_JUSTIFICATION = 15
COL_O_EXPENSE_DATE = 16
COL_O_ALLOCATION_NUMBER = 17
COL_O_ALLOCATION_AMOUNT = 18
COL_O_EXPENSE_ALLOCATION = 19
COL_O_EMPLOYEE_IF_NOT_THE_CLAIMS = 20
COL_O_DEPARTURE_LOCATION = 21
COL_O_DESTINATION = 22
COL_O_MODE_OF_TRANSPORTATION = 23
COL_O_PURPOSE_OF_JOURNEY = 24
COL_O_NAME_OF_GUEST_COMPANY = 25
COL_O_MOST_SENIOR_PARTICIPANT = 26
COL_O_PURPOSE_OF_ENTERTAINMENT = 27
COL_O_COST_PER_HEAD = 28
COL_O_COST_PER_HEAD_BEFORE_TAX = 29
COL_O_NUMBER_OF_PARTICIPANTS = 30
COL_O_NAME_AND_POSITION_OF_PARTICIPANTS = 31
COL_O_TAR_APPROVED_NUMBER = 32
COL_O_REASON_OF_GUEST_NO_DIFF = 33
COL_O_REASON_OF_OTHER_RELATED_EXPENSE = 34
COL_O_ABC_APPROVAL_REFERENCE_NUMBER = 35
COL_O_ADDITIONAL_APPROVER_1 = 36
COL_O_ADDITIONAL_APPROVER_2 = 37
COL_O_EAP_APPROVER_3 = 38
COL_O_ADDITIONAL_APPROVER_4 = 39
COL_O_ADDITIONAL_APPROVER_5 = 40
COL_O_ADDITIONAL_APPROVER_CEO = 41
COL_O_ADDITIONAL_APPROVER_AAE = 42
COL_O_HR_DIVISION_1 = 43
COL_O_HR_DIVISION_2 = 44
COL_O_HR_DIVISION_3 = 45
COL_O_HR_DIVISION_4 = 46
WS_CASE1 = "Date & Amount"
WS_CASE2 = "Date & Amount & Type"
WS_CASE3 = "Date & Amount & Type & Name"
WS_CASE4 = "Professional Fees"
WS_RAW_DATA = "Raw Data"
WS_REQUIREMENTS = "Requirement"
I_TABLE_WIDTH = 99
I_TABLE_HEIGHT = 30000
len_temp_ws_case1 = 0
len_temp_ws_case2 = 0
len_temp_ws_case3 = 0
len_temp_ws_case4 = 0
End Sub
Function CheckWsExist(ws_string)
Dim output As Boolean
On Error GoTo eh
Dim i As Integer
For i = 1 To Worksheets.Count
If (Worksheets.Item(i).Name = ws_string) Then
CheckWsExist = True
Exit Function
End If
Next i
Done:
CheckWsExist = False
Exit Function
eh:
CheckWsExist = False
End Function
Sub CreateWsIfNotExist(ws_string)
If (CheckWsExist(ws_string) = False) Then
Dim newSheet As Worksheet
' Create a new worksheet and assign it to the variable
Set newSheet = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
' Optionally, you can name the new worksheet
newSheet.Name = ws_string
End If
End Sub
Function checkTableLength(ws_string)
Dim output As Integer
Dim r, c As Integer
For r = 1 To I_TABLE_HEIGHT
Dim temp As String
temp = Worksheets(ws_string).Range("A1").Offset(r, 0).Value
If temp = "" Then
output = r
Exit For
End If
Next r
checkTableLength = output - 1 '- 1 for header
End Function
' Case 1
' Situation:
' > If any rows (with different expense number) of both Expense Date (Column Q) and Line Amount (Column L) have the same value
' 1. with different expense number (Column A)
' 2. Expense Date (Column Q) have the same value
' 3. Line Amount (Column L) have the same value
' Action:
' Create a tab (Name: Date & Amount) and copy and paste the related rows to this tab
Sub Case1()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase1()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE1)
Worksheets(WS_CASE1).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE1).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase1(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE, R_SAME_CLAIMANT_NAME As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row1(COL_O_EXPENSE_DATE) = row2(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row1(COL_O_LINE_AMOUNT_HKD) = row2(COL_O_LINE_AMOUNT_HKD)
'
R_SAME_EXPENSE_TYPE = row1(COL_O_EXPENSE_TYPE) = row2(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And Not (R_SAME_EXPENSE_TYPE Or R_SAME_CLAIMANT_NAME)
' Debug.Print R_DIFF_EXPENSE_NUM
Debug.Print "Helloworld"
CheckFullfillCase1 = output
End Function
Function CheckOccurInCase1(row_to_check)
Dim output As Boolean
output = False
Dim r, case1_table_len As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
For r = 0 To len_temp_ws_case1 - 1
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case1(r)(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row_to_check(COL_O_EXPENSE_DATE) = temp_ws_case1(r)(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row_to_check(COL_O_LINE_AMOUNT_HKD) = temp_ws_case1(r)(COL_O_LINE_AMOUNT_HKD)
If (R_SAME_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT) Then
output = True
Exit For
End If
Next r
CheckOccurInCase1 = output
End Function
Sub ProcessCase1()
initSheetForCase1
Dim r, r_c1 As Integer
Dim r_fullfill_case1 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case1 = CheckFullfillCase1(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case1) Then
If (CheckOccurInCase1(AA_RAW_DATA(r))) Then
' if occur in ws_case1, do nothing
Else
temp_ws_case1(len_temp_ws_case1) = AA_RAW_DATA(r)
len_temp_ws_case1 = len_temp_ws_case1 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
End If
If (CheckOccurInCase1(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case1, do nothing
Else
temp_ws_case1(len_temp_ws_case1) = AA_RAW_DATA(r_c1)
len_temp_ws_case1 = len_temp_ws_case1 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case1 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE1).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case1(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE1).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE1).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
' Case 2
' Situation:
' > If any rows (with different expense number) of Expense Date (Column Q), Line Amount (Column L) and Expense Type (Column K) have the same value
' 1. with different expense number (Column A)
' 2. Expense Date (Column Q) have the same value
' 3. Line Amount (Column L) have the same value
' 4. Expense Type (Column K) have the same value
' Action:
' Create a tab (Name: Date & Amount & Type) and copy and paste the related rows to this tab
Sub Case2()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase2()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE2)
Worksheets(WS_CASE2).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE2).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase2(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
Dim R_SAME_CLAIMANT_NAME, R_EXPENSE_TYPE_PROF_FEE As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row1(COL_O_EXPENSE_DATE) = row2(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row1(COL_O_LINE_AMOUNT_HKD) = row2(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row1(COL_O_EXPENSE_TYPE) = row2(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
R_EXPENSE_TYPE_PROF_FEE = row1(COL_O_EXPENSE_TYPE) = "PROF.FEE"
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE And Not (R_SAME_CLAIMANT_NAME Or R_EXPENSE_TYPE_PROF_FEE)
CheckFullfillCase2 = output
End Function
Function CheckOccurInCase2(row_to_check)
Dim output As Boolean
output = False
Dim r, case2_table_len As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
For r = 1 To len_temp_ws_case2 - 1
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case2(r)(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row_to_check(COL_O_EXPENSE_DATE) = temp_ws_case2(r)(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row_to_check(COL_O_LINE_AMOUNT_HKD) = temp_ws_case2(r)(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row_to_check(COL_O_EXPENSE_TYPE) = temp_ws_case2(r)(COL_O_EXPENSE_TYPE)
If (R_SAME_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE) Then
output = True
Exit For
End If
Next r
CheckOccurInCase2 = output
End Function
Sub ProcessCase2()
initSheetForCase2
Dim r, r_c1 As Integer
Dim r_fullfill_case2 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case2 = CheckFullfillCase2(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case2) Then
If (CheckOccurInCase2(AA_RAW_DATA(r))) Then
' if occur in ws_case2, do nothing
Else
temp_ws_case2(len_temp_ws_case2) = AA_RAW_DATA(r)
len_temp_ws_case2 = len_temp_ws_case2 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
End If
If (CheckOccurInCase2(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case2, do nothing
Else
temp_ws_case2(len_temp_ws_case2) = AA_RAW_DATA(r_c1)
len_temp_ws_case2 = len_temp_ws_case2 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case2 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE2).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case2(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE2).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE2).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
' Case 3
' Situation:
' > If any rows (with different expense number) of Expense Date (Column Q), Line Amount (Column L), Expense Type (Column K) and Claimant Name (Column B) have the same value
' 1. with different expense number (Column A)
' 2. Expense Date (Column Q) have the same value
' 3. Line Amount (Column L) have the same value
' 4. Expense Type (Column K) have the same value
' 5. Claimant Name (Column B) have the same value
' Action:
' Create a tab (Name: Date & Amount & Type & Name) and copy and paste the related rows to this tab
Sub Case3()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase3()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE3)
Worksheets(WS_CASE3).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE3).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase3(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
Dim R_EXPENSE_TYPE_PROF_FEE As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_SAME_EXPENSE_DATE = row1(COL_O_EXPENSE_DATE) = row2(COL_O_EXPENSE_DATE)
R_SAME_LINE_AMOUNT = row1(COL_O_LINE_AMOUNT_HKD) = row2(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row1(COL_O_EXPENSE_TYPE) = row2(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
'
R_EXPENSE_TYPE_PROF_FEE = row1(COL_O_EXPENSE_TYPE) = "PROF.FEE"
output = R_DIFF_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE And R_SAME_CLAIMANT_NAME And Not (R_EXPENSE_TYPE_PROF_FEE)
Debug.Print R_DIFF_EXPENSE_NUM
CheckFullfillCase3 = output
End Function
Function CheckOccurInCase3(row_to_check)
Dim output As Boolean
output = False
Dim r As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_EXPENSE_DATE As Boolean
Dim R_SAME_LINE_AMOUNT As Boolean
Dim R_SAME_EXPENSE_TYPE As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
For r = 0 To len_temp_ws_case3 - 1
R_SAME_EXPENSE_DATE = row_to_check(COL_O_EXPENSE_DATE) = temp_ws_case3(r)(COL_O_EXPENSE_DATE)
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case3(r)(COL_O_EXPENSE_NUMBER)
R_SAME_LINE_AMOUNT = row_to_check(COL_O_LINE_AMOUNT_HKD) = temp_ws_case3(r)(COL_O_LINE_AMOUNT_HKD)
R_SAME_EXPENSE_TYPE = row_to_check(COL_O_EXPENSE_TYPE) = temp_ws_case3(r)(COL_O_EXPENSE_TYPE)
R_SAME_CLAIMANT_NAME = row_to_check(COL_O_CLAIMANT_NAME) = temp_ws_case3(r)(COL_O_CLAIMANT_NAME)
If (R_SAME_EXPENSE_NUM And R_SAME_EXPENSE_DATE And R_SAME_LINE_AMOUNT And R_SAME_EXPENSE_TYPE And R_SAME_CLAIMANT_NAME) Then
output = True
Exit For
End If
Next r
CheckOccurInCase3 = output
End Function
Sub ProcessCase3()
initSheetForCase3
Dim r, r_c1 As Integer
Dim r_fullfill_case3 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case3 = CheckFullfillCase3(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case3) Then
If (CheckOccurInCase3(AA_RAW_DATA(r))) Then
' if occur in ws_case3, do nothing
Else
temp_ws_case3(len_temp_ws_case3) = AA_RAW_DATA(r)
len_temp_ws_case3 = len_temp_ws_case3 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_CLAIMANT_NAME).Interior.Color = GetRandomColor
End If
If (CheckOccurInCase3(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case3, do nothing
Else
temp_ws_case3(len_temp_ws_case3) = AA_RAW_DATA(r_c1)
len_temp_ws_case3 = len_temp_ws_case3 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_DATE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_LINE_AMOUNT_HKD).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_CLAIMANT_NAME).Interior.Color = GetRandomColor
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case3 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE3).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case3(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE3).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE3).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
' Case 4
' Situation:
' > If Expense Type (Column K) contains PROF.FEE, and; If any rows (with different expense number) of Claimant Name (Column B) have the same value
' 1. If Expense Type (Column K) contains PROF.FEE
' 2. with different expense number (Column A)
' 3. Claimant Name (Column B) have the same value)
' Action:
' Create a tab (Name: Professional Fees) and copy and paste the related rows to this tab
Sub Case4()
MsgBox "Helloworld"
End Sub
Sub initSheetForCase4()
Dim r, c As Integer
CreateWsIfNotExist (WS_CASE4)
Worksheets(WS_CASE4).Range("A1:Z" & CStr(I_TABLE_HEIGHT)).Offset(r, c).Clear
For c = 0 To 99
Worksheets(WS_CASE4).Range("A1").Offset(0, c).Value = Worksheets(WS_RAW_DATA).Range("A1").Offset(0, c).Value
Next c
End Sub
Function CheckFullfillCase4(row1, row2)
Dim output As Boolean
Dim c As Integer
Dim R_DIFF_EXPENSE_NUM As Boolean
Dim R_EXPENSE_TYPE_PROF_FEE As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
output = True
R_DIFF_EXPENSE_NUM = row1(COL_O_EXPENSE_NUMBER) <> row2(COL_O_EXPENSE_NUMBER)
R_EXPENSE_TYPE_PROF_FEE = row1(COL_O_EXPENSE_TYPE) = "PROF.FEE"
R_SAME_CLAIMANT_NAME = row1(COL_O_CLAIMANT_NAME) = row2(COL_O_CLAIMANT_NAME)
output = R_DIFF_EXPENSE_NUM And R_EXPENSE_TYPE_PROF_FEE And R_SAME_CLAIMANT_NAME
CheckFullfillCase4 = output
End Function
Function CheckOccurInCase4(row_to_check)
Dim output As Boolean
output = False
Dim r As Integer
Dim R_SAME_EXPENSE_NUM As Boolean
Dim R_SAME_CLAIMANT_NAME As Boolean
For r = 0 To len_temp_ws_case4 - 1
R_SAME_EXPENSE_NUM = row_to_check(COL_O_EXPENSE_NUMBER) = temp_ws_case4(r)(COL_O_EXPENSE_NUMBER)
R_SAME_CLAIMANT_NAME = row_to_check(COL_O_CLAIMANT_NAME) = temp_ws_case4(r)(COL_O_CLAIMANT_NAME)
If (R_SAME_EXPENSE_NUM And R_SAME_CLAIMANT_NAME) Then
output = True
Exit For
End If
Next r
CheckOccurInCase4 = output
End Function
Sub ProcessCase4()
initSheetForCase4
Dim r, r_c1 As Integer
Dim r_fullfill_case4 As Boolean
Dim last_row_idx, second_last_row_idx As Integer
last_row_idx = len_raw_data - 1
second_last_row_idx = last_row_idx - 1
For r = 0 To (second_last_row_idx)
For r_c1 = (r + 1) To (last_row_idx)
r_fullfill_case4 = CheckFullfillCase4(AA_RAW_DATA(r), AA_RAW_DATA(r_c1))
If (r_fullfill_case4) Then
If (CheckOccurInCase4(AA_RAW_DATA(r))) Then
' if occur in ws_case4, do nothing
Else
temp_ws_case4(len_temp_ws_case4) = AA_RAW_DATA(r)
len_temp_ws_case4 = len_temp_ws_case4 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r + 1, COL_O_CLAIMANT_NAME).Interior.Color = GetRandomColor
End If
If (CheckOccurInCase4(AA_RAW_DATA(r_c1))) Then
' if occur in ws_case4, do nothing
Else
temp_ws_case4(len_temp_ws_case4) = AA_RAW_DATA(r_c1)
len_temp_ws_case4 = len_temp_ws_case4 + 1
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_EXPENSE_TYPE).Interior.Color = GetRandomColor
Worksheets(WS_RAW_DATA).Range("A1").Offset(r_c1 + 1, COL_O_CLAIMANT_NAME).Interior.Color = GetRandomColor
End If
End If
Next r_c1
Next r
For r = 0 To (len_temp_ws_case4 - 1)
For r_c1 = 0 To 99
Worksheets(WS_CASE4).Range("A1").Offset(r + 1, r_c1).Value = temp_ws_case4(r)(r_c1)
Next r_c1
Next r
Worksheets(WS_CASE4).Range("A1:Z" & 99).Columns.AutoFit
Worksheets(WS_CASE4).Range("A2:Z" & 99).Interior.Color = xlNone
End Sub
Sub ReadRawData()
Dim r, i, j, k As Integer
len_raw_data = checkTableLength(WS_RAW_DATA)
For r = 1 To len_raw_data
Dim test(99) As String
For i = 0 To 99
test(i) = Worksheets(WS_RAW_DATA).Range("A1").Offset(r, i).Value
Next i
AA_RAW_DATA(r - 1) = test
Next r
End Sub
Sub TestMain()
initConfig
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ResetWs
ReadRawData
ProcessCase4
ProcessCase3
ProcessCase2
ProcessCase1
MsgBox "done"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub ResetWs()
Dim i, j As Integer
Dim last_sheet_idx As Integer
last_sheet_idx = Worksheets.Count
For i = 1 To last_sheet_idx
j = last_sheet_idx + 1 - i
Dim IsWsRawData As Boolean
Dim IsWsRequirements As Boolean
Dim IsWsDebug As Boolean
IsWsRawData = Worksheets.Item(j).Name = WS_RAW_DATA
IsWsRequirements = Worksheets.Item(j).Name = WS_REQUIREMENTS
IsWsDebug = Worksheets.Item(j).Name = "debug"
If (IsWsRawData Or IsWsRequirements Or IsWsDebug) Then
Else
Worksheets.Item(j).Delete
End If
Next
Dim r, table_length As Integer
table_length = checkTableLength(WS_RAW_DATA)
For r = 1 To table_length + 10
Worksheets(WS_RAW_DATA).Range("A1:Z" & CStr(table_length + 10)).Offset(r, 0).Interior.Color = xlNone
Next r
End Sub
Function GetRandomColor()
Dim randR As Integer
Dim randG As Integer
Dim randB As Integer
Randomize
randR = Int((256) * Rnd)
randG = Int((256) * Rnd)
randB = Int((256) * Rnd)
GetRandomColor = RGB(246, 229, 141)
End Function

3
task4/source/slow/dev.bat Normal file
View File

@@ -0,0 +1,3 @@
del Module1.bas
xlwings vba edit --file .\Expense_Report_trunk.xlsm