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