EXCEL VBA算寫字樓的租賃情況

用EXCEL維護了寫字樓的租賃情況，需要用BI工具分析，於是就寫了個VBA進行分析。

Sub Rental_Click()

'判斷變量的類型函數
'VarType = TypeName("fafafas")
'第一步拷貝EXCEL標題
    Sheet2.Activate
    Sheet2ColumnCount = Sheet2.UsedRange.Columns.Count
    
    For i = 1 To Sheet2ColumnCount
        Sheet3.Cells(1, i).Value = Sheet2.Cells(1, i).Value            '把Sheet2的擡頭拷貝到Sheet3裏
    Next
    
    k = 1
'把Sheet2從第二行開始的所有的記錄都拆分成月份，同時拷貝到Sheet3裏
    Sheet2.Activate
    Sheet2RowCount = Sheet2.UsedRange.Rows.Count
    For i = 2 To Sheet2RowCount
            '客戶名稱
            strKHMC = Sheet2.Cells(i, 1).Value
            '租金
            nRentMoney = Sheet2.Cells(i, 4).Value
            'RoomNum
            strRoomNum = Sheet2.Cells(i, 5).Value
            'Space
            nSpace = Sheet2.Cells(i, 6).Value
            ' 計算Unit Rental[每天每平米的租金= Round(((nRentMoney * 12) / 365) / nSpace, 2)],是不考慮免租期的
            'UnitRental
            nUnitRental = Round(((nRentMoney * 12) / 365) / nSpace, 2)
            '記錄下此時此行記錄的開始日期和結束日期
            dFixedStartDate = Sheet2.Cells(i, 2).Value
            dFixedEndDate = Sheet2.Cells(i, 3).Value
            
            '記錄下此時此行記錄的開始日期和結束日期,這兩個日期變量是用來做下面的循環計算只用的
            
            '租賃開始日期
            dStartDate = Sheet2.Cells(i, 2).Value
            '租賃結束日期
            dEndDate = Sheet2.Cells(i, 3).Value
            

            nCountMonth = 0 '計算月份循環次數
            nLoopCount = 0 '表示內循環的次數,  如果是第一次開始循環加一天就進入下個月的話，這種情況也特別對待
            Do While (dStartDate <= dEndDate)
                nLoopCount = nLoopCount + 1
                '剛進入此do while循環的時候,開始日期肯定是dFixedStartDate
                dStartDateTemp = dFixedStartDate
                dStartDate = dStartDate + 1
                '如果月份時不相等的，則表示進入了下一個月，這個時候，我就可以拷貝dStartDate對應的信息
                If strKHMC = "上海玖忻商務諮詢有限公司" Then
                    a = 2
                End If
                If nLoopCount = 1 And Month(dFixedStartDate) <> Month(dFixedStartDate + 1) Then '還有一種情況是上海玖忻商務諮詢有限公司    2011/11/30  2013/12/28開始日期是一個月的最後一天
                    dStartDateTemp = dFixedStartDate  '結束和開始日期一樣的
                    dEndDateTemp = dFixedStartDate
                    dCurrentMonthEndDate = dFixedStartDate
                    
                    nCountMonth = nCountMonth + 1

                    
                    '這k需要全局變量
                    k = k + 1
                    '客戶名稱
                    Sheet3.Cells(k, 1).Value = strKHMC
                    '本月的開始日期
                    Sheet3.Cells(k, 2).Value = dStartDateTemp
                    '本月的結束日期
                    Sheet3.Cells(k, 3).Value = dEndDateTemp
                    '本月的租金
                    Sheet3.Cells(k, 4).Value = nRentMoney
                    'RoomNum
                    Sheet3.Cells(k, 5).Value = strRoomNum
                    'Space
                    Sheet3.Cells(k, 6).Value = nSpace
                    'UnitRental
                    Sheet3.Cells(k, 12).Value = nUnitRental
                ElseIf Month(dStartDate) <> Month(dStartDate + 1) Or (dStartDate = dEndDate) Then
                    '本月的結束日期
                    dCurrentMonthEndDate = dStartDate
                    '計算月份循環次數，目的是爲了記錄第一次循環的的開始日期
                    nCountMonth = nCountMonth + 1
                    '要知道他的一個月份時間段中的開始
                    If nCountMonth = 1 Then
                        dStartDateTemp = dFixedStartDate
                        '此時這個月的結束日期肯定是dStartDate
                        dEndDateTemp = dStartDate
                    Else
                        '此時這個月的結束日期肯定是dStartDate
                        dStartDateTemp = dNextMonthStartDate
                        dEndDateTemp = dStartDate
                    End If
                    
                    
                    '這k需要全局變量
                    k = k + 1
                    '客戶名稱
                    Sheet3.Cells(k, 1).Value = strKHMC
                    '本月的開始日期
                    Sheet3.Cells(k, 2).Value = dStartDateTemp
                    '本月的結束日期
                    Sheet3.Cells(k, 3).Value = dEndDateTemp
                    '本月的租金
                    Sheet3.Cells(k, 4).Value = nRentMoney
                    'RoomNum
                    Sheet3.Cells(k, 5).Value = strRoomNum
                    'Space
                    Sheet3.Cells(k, 6).Value = nSpace
                    'UnitRental
                    Sheet3.Cells(k, 12).Value = nUnitRental
                End If
                
                '下個月的開始日期
                dNextMonthStartDate = dCurrentMonthEndDate + 1
            Loop
    Next

End Sub

Sub Rental2_Click()

    '免租期和改變租金的信息(千萬注意：如果客戶的租賃時間的開始一個月和結束的月份不是免租的而且不是足月天數的也需要在ChangedInfo裏添加上相應的信息，同時把租金按照公式: (月租金*12/365)*該月的有效天數)
    'ChangedInfo裏面保存的是所有的修改的信息，執行的時候會按照customer+startdate+enddate+roomnum匹配
    '外循環是sheet3,內循環是sheet5
    '處理邏輯思想：
    'step 1,SplitInfo裏面保存的是免租期跨月份的需要被拆分的信息，我先需要用此信息去把HandledData刪除掉和此信息一樣的那行記錄，再做下面的2，3 步驟
    'step 2,如果在HandledData裏找到和ChangedInfo一樣的記錄，則就用ChangedInfo裏的FaceRental來替換HandledData裏的FaceRental，注意這些信息包含(1，被拆分的 2，租戶的開始和結束月份不是租月的)
    'step 3,如果在HandledData裏找不到和ChangedInfo一樣的記錄，則就把ChangedInfo裏的此條信息插入到HandledData裏
    
    
    
    Call Step1
    
    Call Step2_3
    
    '一定要在Step2_3之後調用OrderBy
    Call OrderBy
    
    
    Call Step4

    
    
   'Call IfHasException

    

    
    Call CalDiffRental

End Sub
Sub Step1()
    Sheet4.Activate
    Sheet4RowCount = Sheet4.UsedRange.Rows.Count
    
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    For k = 2 To Sheet4RowCount
        strOuterCustomer = Sheet4.Cells(k, 1).Value
        dOuterStartDate = Sheet4.Cells(k, 2).Value
        dOuterEndDate = Sheet4.Cells(k, 3).Value
        strOuterRoomNum = Sheet4.Cells(k, 5).Value
        For p = 2 To Sheet3RowCount
            strInnerCustomer = Sheet3.Cells(p, 1).Value
            dInnerStartDate = Sheet3.Cells(p, 2).Value
            dInnerEndDate = Sheet3.Cells(p, 3).Value
            strInnerRoomNum = Sheet3.Cells(p, 5).Value
            If strOuterCustomer = strInnerCustomer And dOuterStartDate = dInnerStartDate And dOuterEndDate = dInnerEndDate And strOuterRoomNum = strInnerRoomNum Then
                Sheet3.Rows(p).Delete
            End If
        Next
    
    Next
End Sub
Sub Step2_3()
 
    'step2 step3
    Sheet5.Activate
    Sheet5RowCount = Sheet5.UsedRange.Rows.Count
    
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    strFoundFlag = "NO"  '標記是否在HandledData裏找到和ChangedInfo一樣的記錄相應的記錄，默認是找到
    
    For k = 2 To Sheet5RowCount
        strFoundFlag = "NO"
        strOuterCustomer = Sheet5.Cells(k, 1).Value
        dOuterStartDate = Sheet5.Cells(k, 2).Value
        dOuterEndDate = Sheet5.Cells(k, 3).Value
        nOuterFaceRental = Sheet5.Cells(k, 4).Value
        strOuterRoomNum = Sheet5.Cells(k, 5).Value
        nOuterSpace = Sheet5.Cells(k, 6).Value
        nOuterUnitRental = Sheet5.Cells(k, 8).Value
        
        For p = 2 To Sheet3RowCount
            strInnerCustomer = Sheet3.Cells(p, 1).Value
            dInnerStartDate = Sheet3.Cells(p, 2).Value
            dInnerEndDate = Sheet3.Cells(p, 3).Value
            strInnerRoomNum = Sheet3.Cells(p, 5).Value
            If strOuterCustomer = strInnerCustomer And dOuterStartDate = dInnerStartDate And dOuterEndDate = dInnerEndDate And strOuterRoomNum = strInnerRoomNum Then
                strFoundFlag = "YES"
                Sheet3.Cells(p, 4).Value = Sheet5.Cells(k, 4).Value
                'UnitRental
                Sheet3.Cells(p, 12).Value = Sheet5.Cells(k, 8).Value
                Sheet3.Cells(p, 4).Interior.ColorIndex = 6  '黃色
                'Sheet3.Rows(p - 2).Interior.ColorIndex = 3  ' 背景的顏色爲3 紅色
            End If
        Next
        If strFoundFlag = "NO" Then  '需要把sheet5的此條記錄copy到Sheet3的末尾
            '在sheet3的最後一行後面增加一行插入
            Sheet3CurrRowCount = Sheet3.UsedRange.Rows.Count + 1
            
            Sheet3.Cells(Sheet3CurrRowCount, 1).Value = strOuterCustomer
            '本月的開始日期
            Sheet3.Cells(Sheet3CurrRowCount, 2).Value = dOuterStartDate
            '本月的結束日期
            Sheet3.Cells(Sheet3CurrRowCount, 3).Value = dOuterEndDate
            '本月的租金
            Sheet3.Cells(Sheet3CurrRowCount, 4).Value = nOuterFaceRental
            'RoomNum
            Sheet3.Cells(Sheet3CurrRowCount, 5).Value = strOuterRoomNum
            'Space
            Sheet3.Cells(Sheet3CurrRowCount, 6).Value = nOuterSpace
            'UnitRental
            Sheet3.Cells(Sheet3CurrRowCount, 12).Value = nOuterUnitRental
            
            '一整行都設置成黃色，表示是新插入的一條記錄
            Sheet3.Rows(Sheet3CurrRowCount).Interior.ColorIndex = 6
        End If
        
    Next
End Sub

Sub Step4()

' facerental 已經在拆分裏算好了。(月租金*12/365)*當月的天數
'加一天是否是變成下一個月了，來判斷是否是最後一天
'---從Period之後都要重新計算-----


'增加相關字段Period like 201406
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    For p = 1 To Sheet3RowCount
        If p = 1 Then
            '添加一個標題,主要一定要是雙引號
            Sheet3.Cells(p, 7).Value = "Period"
            Sheet3.Cells(p, 8).Value = "Year"
            Sheet3.Cells(p, 9).Value = "Month"
        Else
            strCurYear = CStr(Year(Sheet3.Cells(p, 2).Value))
            strCurMonth = CStr(Month(Sheet3.Cells(p, 2).Value))
            If Len(strCurMonth) = 1 Then
                strCurMonth = "0" & strCurMonth
            End If
            Sheet3.Cells(p, 7).Value = strCurYear & strCurMonth
            Sheet3.Cells(p, 8).Value = strCurYear
            Sheet3.Cells(p, 9).Value = strCurMonth
        End If
    Next
    
   '算有效天數
   
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    For p = 1 To Sheet3RowCount
        If p = 1 Then
            Sheet3.Cells(p, 10).Value = "EffetiveDays"
            Sheet3.Cells(p, 11).Value = "EffetiveRental"
            Sheet3.Cells(p, 12).Value = "UnitRental"
            Sheet3.Cells(p, 13).Value = "Category"               '直接是round(cells(12),0)
            Sheet3.Cells(p, 14).Value = "CategoryRange"     'UnitRental是和sheet:CategoryRange裏的值通過一定的算法而得到的
            Sheet3.Cells(p, 15).Value = "DiffRental"     'EffetiveRental-FaceRental得到的
            
            Sheet3.Cells(p, 16).Value = "ColumnP"
            Sheet3.Cells(p, 17).Value = "ColumnQ"
            Sheet3.Cells(p, 18).Value = "ColumnR"
            Sheet3.Cells(p, 19).Value = "ColumnS_Current"
            Sheet3.Cells(p, 20).Value = "ColumnT_None_Current"
            
        Else
            Sheet3.Cells(p, 10).Value = Sheet3.Cells(p, 3).Value - Sheet3.Cells(p, 2).Value + 1
        End If
    Next
    
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    For p = 2 To Sheet3RowCount
        nStartDate = Day(Sheet3.Cells(p, 2).Value)
        nEndDate = Sheet3.Cells(p, 3).Value
        nOldMonth = Month(nEndDate)
        nNewMonth = Month(nEndDate + 1)
        nDays = Sheet3.Cells(p, 3).Value - Sheet3.Cells(p, 2).Value + 1
    Next
    
    
    '有效租金值EffectiveRental(一定要注意是需要按照customer+roomnum來計算的,否則不唯一可能)
    j = 1
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    '計算一個客戶的行數
    nTotalRowsOfEachKHMC = 0
    nTotalEffectiveDaysOfEachKHMC = 0
    nTotalRentalMoneyOfEachKHMC = 0
    
    
    
    nStartPos = 2
    For p = 2 To Sheet3RowCount
        strKHMC = Sheet3.Cells(p, 1).Value
        strNextKHMC = Sheet3.Cells(p + 1, 1).Value
        strRoomNum = Sheet3.Cells(p, 5).Value
        strNextRoomNum = Sheet3.Cells(p + 1, 5).Value
        strKeyKHMC = strKHMC + CStr(strRoomNum)
        strNextKeyKHMC = strNextKHMC + CStr(strNextRoomNum)
        
         
        If strKeyKHMC = strNextKeyKHMC Then
            nTotalEffectiveDaysOfEachKHMC = nTotalEffectiveDaysOfEachKHMC + Sheet3.Cells(p, 10).Value
            nTotalRentalMoneyOfEachKHMC = nTotalRentalMoneyOfEachKHMC + Sheet3.Cells(p, 4).Value
        Else
            nTotalEffectiveDaysOfEachKHMC = nTotalEffectiveDaysOfEachKHMC + Sheet3.Cells(p, 10).Value
            nTotalRentalMoneyOfEachKHMC = nTotalRentalMoneyOfEachKHMC + Sheet3.Cells(p, 4).Value
        '客戶不相等的開始位置
            nCurTempPos = p
            '平均租金=該客戶的總租金/該客戶的租的天數
            nAverageMoney = nTotalRentalMoneyOfEachKHMC / nTotalEffectiveDaysOfEachKHMC
            For k = nStartPos To nCurTempPos
                Sheet3.Cells(k, 11).Value = Round(nAverageMoney * Sheet3.Cells(k, 10).Value, 2)
            Next

            nTotalEffectiveDaysOfEachKHMC = 0
            nTotalRentalMoneyOfEachKHMC = 0
            '下一次開始位置
            nStartPos = nCurTempPos + 1
        End If
    Next
    
    

    ' 計算Category的分類
    '1, source value: random value from Sheet3.Cells(p, 12).Value
    '2, we have another Excel have the target value we need to be showed in our BI dashboard sorted ascending
    'Use the  1 compare with the 2 ,find the first larger one from the 2 as the target value. If I can't find the larger value from 2, then just use the value from 1 as the target value
    
    'source value           expected value    target value
    ' 3.1                    2.4               4.3
    ' 4.3                    4.3               4.3
    ' 7.8                    6.5               8.0
    ' 19                     8.0               19
    
    Sheet1.Activate
    Sheet1RowCount = Sheet1.UsedRange.Rows.Count
    boolFlag = "NO"  '是否從sheet1中找到符合條件的值
    
    Sheet3.Activate
    For p = 2 To Sheet3RowCount
        'UnitRental的算法改變了，是按照合同租金變化後需要重新計算，下面的算法是一個客戶在整個期間的平均值
        'Sheet3.Cells(p, 12).Value = Round((Sheet3.Cells(p, 11).Value / Sheet3.Cells(p, 6).Value) / Sheet3.Cells(p, 10).Value, 4)
        Sheet3.Cells(p, 13).Value = Round(Sheet3.Cells(p, 12).Value)
        
        boolFlag = "NO"
        For k = 1 To Sheet1RowCount
            If Sheet3.Cells(p, 12).Value <= Sheet1.Cells(k, 1).Value Then
                Sheet3.Cells(p, 14).Value = Sheet1.Cells(k, 1).Value
                boolFlag = "YES"
                Exit For
            End If
        Next
        
        If boolFlag = "NO" Then
            Sheet3.Cells(p, 14).Value = Round(Sheet3.Cells(p, 12).Value, 2)
        End If
    Next
End Sub

Sub IfHasException()
 
   '查找一個客戶的第五個FaceRental和倒數第二個FaceRental，如果 倒數第二個FaceRental/第五個FaceRental>15%就顯示紅色
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    '記錄同一個客戶的循環指針的位置
    nCountPosByCustomer = 0
    '客戶的第五個FaceRental的值
    nStartFaceRentalValue = 0
    '客戶倒數第二個FaceRental的值
    nLast2ndFaceRentalValue = 0
    
    For p = 2 To Sheet3RowCount
        strKHMC = Sheet3.Cells(p, 1).Value
        strNextKHMC = Sheet3.Cells(p + 1, 1).Value
        If strKHMC = strNextKHMC Then
            nCountPosByCustomer = nCountPosByCustomer + 1
            If nCountPosByCustomer = 5 Then
                nStartFaceRentalValue = Sheet3.Cells(p, 4).Value
            End If
        Else
            nLast2ndFaceRentalValue = Sheet3.Cells(p - 2, 4).Value
            If nCountPosByCustomer > 5 Then  '因爲有客戶的租期小於5個月
                If (nLast2ndFaceRentalValue - nStartFaceRentalValue) / nStartFaceRentalValue > 0.15 Then
                    Sheet3.Rows(p - 2).Interior.ColorIndex = 3  ' 背景的顏色爲3 紅色
                End If
            End If

            nCountPosByCustomer = 0
            '客戶的第五個FaceRental的值
            nStartFaceRentalValue = 0
            '客戶倒數第二個FaceRental的值
            nLast2ndFaceRentalValue = 0
        End If
    Next
End Sub
Sub CalDiffRental()
    Dim p As Integer
    
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    For p = 2 To Sheet3RowCount
        'Sheet3.Cells(p, 15).Value = "DiffRental"     'EffetiveRental-FaceRental得到的
        Sheet3.Cells(p, 15).Value = Round(Sheet3.Cells(p, 11).Value - Sheet3.Cells(p, 4).Value, 2)
    Next
    
    
    '計算邏輯：先算Q列的值，
    'a,如果Q列的值是負數，則到O列的對應行的後面的12行正數相加後的值放到P列，這個P列是和此時的Q是在同一行的
    'b,如果Q列的值是正數，則到O列的對應行的後面的12行負數相加後的值放到P列，這個P列是和此時的Q是在同一行的
    
    '按照 customer+roomnum來統計，因爲這樣客戶纔是唯一的。
    'Q列：歷史的sum(O列)，在BI裏給此列做一個趨勢圖
    'R列：abs(Q)列值-abs(P)列值
    'S列：if R列<=0 then S列=abs(Q列值)，T列=0  else S列=abs(P列值)，T列= abs(Q)-abs(P)
    
    
    
    
    '計算Q列：歷史的sum(O列)，在BI裏給此列Q列做一個趨勢圖
    Call Cal_Q_Column_Value
    
    
    '計算P列值
    nStartPos = 2
    For p = 2 To Sheet3RowCount
        strKHMC = Sheet3.Cells(p, 1).Value
        strNextKHMC = Sheet3.Cells(p + 1, 1).Value
        strRoomNum = Sheet3.Cells(p, 5).Value
        strNextRoomNum = Sheet3.Cells(p + 1, 5).Value
        
        
        strKeyKHMC = strKHMC + CStr(strRoomNum)
        strNextKeyKHMC = strNextKHMC + CStr(strNextRoomNum)
         
        If strKeyKHMC = strNextKeyKHMC Then
        
            '每個都必須判斷12次，而且從大到小的判斷
            Dim j As Integer
            
            For j = 12 To 1 Step -1
                If MyRecursion(p, j) = True Then
                    Exit For
                End If
            Next
        End If
    Next
    

    '計算Q列：歷史的sum(O列)，在BI裏給此列做一個趨勢圖
    Call Cal_Q_S_T_Column_Value
    
    
End Sub
'nSheet3RowsNum sheet3光標所在的行號
'iInnerLoopRowsCount 同一個客戶後面還有的行數，是用來算P列的值
Function MyRecursion(nSheet3RowsNum As Integer, iInnerLoopRowsCount As Integer) As Boolean

    '在當前行的基礎上加上iInnerLoopRowsCount行，判斷是否還是同一個客戶
    strTempKHMC = Sheet3.Cells(nSheet3RowsNum + iInnerLoopRowsCount, 1).Value
    strTempNextKHMC = Sheet3.Cells(nSheet3RowsNum + iInnerLoopRowsCount + 1, 1).Value
    strTempRoomNum = Sheet3.Cells(nSheet3RowsNum + iInnerLoopRowsCount, 5).Value
    strTempNextRoomNum = Sheet3.Cells(nSheet3RowsNum + iInnerLoopRowsCount + 1, 5).Value

    strTempKeyKHMC = strTempKHMC + CStr(strTempRoomNum)
    strTempNextKeyKHMC = strTempNextKHMC + CStr(strTempNextRoomNum)
    
    '如果是後面的iInnerLoopRowsCount行還是同一個客戶的話
    If strTempKeyKHMC = strTempNextKeyKHMC Then
        nTempValue = 0
        Sheet3.Cells(nSheet3RowsNum, 16).Value = 0 '賦0值，免得下面會計算出錯
        
        If Sheet3.Cells(nSheet3RowsNum, 17).Value < 0 Then
            For nInnerLoop = 1 To iInnerLoopRowsCount
                If Sheet3.Cells(nSheet3RowsNum + nInnerLoop, 15).Value > 0 Then
                    nTempValue = nTempValue + Sheet3.Cells(nSheet3RowsNum + nInnerLoop, 15).Value
                    Sheet3.Cells(nSheet3RowsNum, 16).Value = nTempValue
                End If
            Next
        Else
            For nInnerLoop = 1 To iInnerLoopRowsCount
                If Sheet3.Cells(nSheet3RowsNum + nInnerLoop, 15).Value < 0 Then
                    nTempValue = nTempValue + Sheet3.Cells(nSheet3RowsNum + nInnerLoop, 15).Value
                    Sheet3.Cells(nSheet3RowsNum, 16).Value = nTempValue
                End If
            Next
        End If
        
        MyRecursion = True
    Else
        MyRecursion = False
    End If
End Function


Sub Cal_Q_Column_Value()
    
    nStartPos = 2  '每一個新客戶的在EXCEL中的開始位置
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    For p = 2 To Sheet3RowCount
        strKHMC = Sheet3.Cells(p, 1).Value
        strNextKHMC = Sheet3.Cells(p + 1, 1).Value
        strRoomNum = Sheet3.Cells(p, 5).Value
        strNextRoomNum = Sheet3.Cells(p + 1, 5).Value
        strKeyKHMC = strKHMC + CStr(strRoomNum)
        strNextKeyKHMC = strNextKHMC + CStr(strNextRoomNum)
         
        If strKeyKHMC = strNextKeyKHMC Then
            If p = nStartPos Then
                Sheet3.Cells(p, 17).Value = Sheet3.Cells(p, 15).Value
            Else
                Sheet3.Cells(p, 17).Value = Sheet3.Cells(p, 15).Value + Sheet3.Cells(p - 1, 17).Value
            End If
        Else
            '客戶不相等的開始位置
            nCurTempPos = p
            '下一次開始位置
            nStartPos = nCurTempPos + 1
        End If
    Next
End Sub



    'R列：abs(Q)列值-abs(P)列值
    'S列：if R列<=0 then S列=abs(Q列值)，T列=0  else S列=abs(P列值)，T列= abs(Q)-abs(P)

Sub Cal_Q_S_T_Column_Value()
    Sheet3.Activate
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    For p = 2 To Sheet3RowCount
       Sheet3.Cells(p, 18).Value = Abs(Sheet3.Cells(p, 17).Value) - Abs(Sheet3.Cells(p, 16).Value)
       
       If Sheet3.Cells(p, 18).Value <= 0 Then
          Sheet3.Cells(p, 19).Value = Abs(Sheet3.Cells(p, 17).Value)
          Sheet3.Cells(p, 20).Value = 0
       Else
          Sheet3.Cells(p, 19).Value = Abs(Sheet3.Cells(p, 16).Value)
          Sheet3.Cells(p, 20).Value = Abs(Sheet3.Cells(p, 17).Value) - Abs(Sheet3.Cells(p, 16).Value)
       End If
    Next
End Sub

Sub OrderBy()
'
' orderby 宏
'

'
    Sheet3RowCount = Sheet3.UsedRange.Rows.Count
    
    ActiveWorkbook.Worksheets("HandledData").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("HandledData").Sort.SortFields.Add Key:=Range( _
        "A2:A" & Sheet3RowCount), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("HandledData").Sort.SortFields.Add Key:=Range( _
        "E2:E" & Sheet3RowCount), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    ActiveWorkbook.Worksheets("HandledData").Sort.SortFields.Add Key:=Range( _
        "B2:B" & Sheet3RowCount), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("HandledData").Sort
        .SetRange Range("A1:O" & Sheet3RowCount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub