805 lines
24 KiB
QBasic
805 lines
24 KiB
QBasic
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
|