Excel自动运算VBA脚本

前几天给老爹写了一个Excel自动运算脚本，能自动根据产品编号取产品名称，自动统计相同编号产品的进货、发货量。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
    Dim columnLingshou, columnPifa As Variant
    Dim columnShouhuo, columnChuhuo As String
    
    '############# 销售清单零售编号列名 ###############
    columnLingshou = Array("AK", "BC", "BU", "CM")
    '############# 销售清单批发编号列名 ###############
    columnPifa = Array("AT", "BL", "CD", "CV")
    '############# 收货清单编号列名 ###############
    columnShouhuo = "EU"
    '############# 出货清单编号列名
    columnChuhuo = "FI"
    
    Dim column As String
    Dim rowNum As Long
    
    If Source.Count = 1 Then
        '单独修改一个
        rowNum = Val(GetRow(Source))
        column = GetColumn(Source)
        If CheckRowInRange(Sh, rowNum, column, columnLingshou, columnPifa, columnShouhuo, columnChuhuo) = False Then
            Exit Sub
        End If
        
        Call UpdateCells(Sh, rowNum, column, Source, columnLingshou, columnPifa, columnShouhuo, columnChuhuo)
    Else
        '一次修改多个
        '取第一个单元格地址
        Dim firstAddress As String
        Dim firstRange As Range
        firstAddress = Mid(Source.address, 1, InStr(1, Source.address, ":") - 1)
        Set firstRange = Sh.Range(firstAddress)
        '循环取地址
        Dim addressCount As Integer
        addressCount = UBound(Source.Value2)
        For i = 0 To addressCount
            Dim addressNow As Range
            Set addressNow = firstRange.Offset(i, 0)
            
            rowNum = Val(GetRow(addressNow))
            column = GetColumn(addressNow)
            
            If CheckRowInRange(Sh, rowNum, column, columnLingshou, columnPifa, columnShouhuo, columnChuhuo) = True Then
                Call UpdateCells(Sh, rowNum, column, addressNow, columnLingshou, columnPifa, columnShouhuo, columnChuhuo)
            End If
        Next
    End If
End Sub

'获取列号
Function GetColumn(rng As Range) As String
    GetColumn = Mid(rng.address, 2, InStr(2, rng.address, "$") - 2)
End Function

'获取行号
Function GetRow(rng As Range) As String
    GetRow = Mid(rng.address, InStr(2, rng.address, "$") + 1)
End Function

'更新单元格
Sub UpdateCells(ByVal Sh As Object, ByVal rowNum As Long, ByVal column As String, ByVal address As Range, _
        columnLingshou As Variant, columnPifa As Variant, ByVal columnShouhuo As String, ByVal columnChuhuo As String)
    If IsInArray(column, columnLingshou) Or IsInArray(column, columnPifa) Or column = columnShouhuo Or column = columnChuhuo Then
        Dim productInfoRow As Long
        productInfoRow = 0
        '更新产品名称
        Dim productName As String
        productName = GetProductName(Sh, Sh.Cells(rowNum, column).Value, productInfoRow)
        If productName = Null Then
            Exit Sub
        End If
        
        Call SetProductName(Sh, address, productName)
        Dim sellCount As Long
        
        '销售清单
        If IsInArray(column, columnLingshou) Or IsInArray(column, columnPifa) Then
            '############# 数量相比编号的偏移量 3 ###############
            sellCount = Sh.Cells(GetRow(address), GetColumn(address.Offset(0, 3))).Value
            If productInfoRow > 3 Then
                '更新零售汇总
                If IsInArray(column, columnLingshou) Then
                    '############# 零售汇总列名 Q ###############
                    Sh.Cells(productInfoRow, "Q").Value = Sh.Cells(productInfoRow, "Q").Value + sellCount
                '更新批发汇总
                ElseIf IsInArray(column, columnPifa) Then
                    '############# 批发汇总列名 R ###############
                    Sh.Cells(productInfoRow, "R").Value = Sh.Cells(productInfoRow, "R").Value + sellCount
                End If
            End If
        ElseIf column = columnShouhuo Or column = columnChuhuo Then
            '############# 数量相比编号的偏移量 2 ###############
            sellCount = Sh.Cells(GetRow(address), GetColumn(address.Offset(0, 2))).Value
            If productInfoRow > 0 Then
                '更新进货汇总
                If column = columnShouhuo Then
                    '############# 进货汇总列名 N ###############
                    Sh.Cells(productInfoRow, "N").Value = Sh.Cells(productInfoRow, "N").Value + sellCount
                '更新出货汇总
                ElseIf column = columnChuhuo Then
                    '############# 出货汇总列名 R ###############
                    Sh.Cells(productInfoRow, "O").Value = Sh.Cells(productInfoRow, "O").Value + sellCount
                End If
            End If
        End If
    End If
End Sub

'获取指定编号的产品名称
Function GetProductName(ByVal Sh As Object, code As String, ByRef productInfoRow As Long) As String

    If code = "" Then
        Exit Function
    End If
    
    Dim i As Long
    Dim rows As Long
    rows = Sh.UsedRange.rows.Count
    For i = 4 To rows
        If Sh.Cells(i, 1).Value = code Then
            GetProductName = Sh.Cells(i, 2).Value
            productInfoRow = i
            Exit For
        End If
    Next
End Function

'填充产品名称
Sub SetProductName(ByVal Sh As Object, ByVal Source As Range, productName As String)
    Sh.Cells(GetRow(Source.Offset(0, 1)), GetColumn(Source.Offset(0, 1))).Value = productName
End Sub

'检查行号是否在范围内
Function CheckRowInRange(ByVal Sh As Object, ByVal rowNum As Long, ByVal column As String, _
        ByVal columnLingshou As Variant, ByVal columnPifa As Variant, ByVal columnShouhuo As String, ByVal columnChuhuo As String) As Boolean
    Dim rows As Long
    rows = Sh.UsedRange.rows.Count
    If rowNum > rows Then
        CheckRowInRange = False
        Exit Function
    End If
    
    Dim rowIndex As Integer
    If IsInArray(column, columnLingshou) Or IsInArray(column, columnPifa) Then
        rowIndex = (rowNum - 5) Mod 26
        If rowIndex > 8 And rowIndex < 23 Then
            CheckRowInRange = True
            Exit Function
        Else
            CheckRowInRange = False
            Exit Function
        End If
    ElseIf column = columnShouhuo Or column = columnChuhuo Then
        rowIndex = (rowNum - 3) Mod 33
        If rowIndex > 0 And rowIndex < 31 Then
            CheckRowInRange = True
            Exit Function
        Else
            CheckRowInRange = False
            Exit Function
        End If
    End If
End Function

'判断字符串是否包含在数组内
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function