VBA小记

要放假了,可是我们,我还是煎熬!

最让人不爽的是媳妇也需要加班加点的完成一些看起来很EASY的事:

统计数据,把几个表合并……

EXCEL本人还是懂得一点点的（我不想说我是学计算机的，我怕给学计算机的同志们丢脸）

早答应媳妇要给做一个程序，可以方便她做表的，可是一直没有做，

这里给媳妇道个歉！媳妇，我错了：）

那就做吧，具体怎么做就不再说，这里主要是把用到的一些程序做一个记录，以防以后还会用到。

代码有点不堪，高手请自行飘过~~~~~~~~~~

'点击开始计算，根据输入的表名，行，列
'简单的判断下有没有输入数据
'没有做严格的正则的匹配判断
Private Sub beginSum_Click()
    Dim sheetName As String
    Dim beginRow As Integer
    Dim endRow As Integer
    Dim beginCol As Integer
    Dim endCol As Integer
    Dim sumCol As Integer
    
    sheetName = tbSheetName.Text
    beginRow = tbBeginRow.Text
    endRow = tbEndRow.Text
    beginCol = tbBeginCol.Text
    endCol = tbEndCol.Text
    sumCol = tbSumCol.Text
    
    If Len(sheetName) = 0 Then
        MsgBox "请输入正确的Sheet名称"
        Exit Sub
    ElseIf Not (IsNumeric(beginRow) And IsNumeric(endRow) And IsNumeric(endRow) And IsNumeric(beginCol) And IsNumeric(endCol) And IsNumeric(sumCol)) Then
        MsgBox "请输入正确的行或列数"
        Exit Sub
    End If
    
    Call CountPersonYear(sheetName, beginRow, endRow, beginCol, endCol, sumCol)
    MsgBox "计算完成!"
    
End Sub

'计算过程－－有点复杂，先每行求和，再把同一个人的N个月的数据再求和，再加上某个月的前N（2）项
'当然，前提是在每个人的信息后面要插入一个空行 见 InsertRow()
'然后把这个总数写入到另一个固定列的表中，见WriteToTable()
Sub CountPersonYear(sheetName As String, beginRow As Integer, endRow As Integer, beginCol As Integer, endCol As Integer, sumCol As Integer)
    Dim personBeginRow As Integer
    Dim mySum As Double
    Dim bigMonth As Integer
    Dim curMonth As Integer
    
    Dim i As Integer
    Dim j As Integer
    
    Dim myWorkBook As Workbook
    Dim mySheet As Worksheet
    
    Set myWorkBook = Application.ActiveWorkbook
    Set mySheet = myWorkBook.Sheets(sheetName)
    
    personBeginRow = beginRow
    bigMonth = mySheet.Cells(beginRow, 2)
    'mySum = 0#
    endRow = endRow + 1
    
    For i = beginRow To endRow
        curMonth = mySheet.Cells(i, 2)
        If (Len(curMonth) <> 0 And curMonth <> 0) Then
            For j = beginCol To endCol
                mySum = mySum + mySheet.Cells(i, j)
            Next
            mySheet.Cells(i, sumCol) = mySum
            mySum = CDbl(0)
        ElseIf (mySheet.Cells(i - 1, 2) <> 0 And Len(mySheet.Cells(i - 1, 2)) <> 0) Then
        
            For j = personBeginRow To i - 1
                mySum = mySum + CDbl(mySheet.Cells(j, sumCol))
            Next
            
            mySheet.Cells(i, sumCol) = mySum + CDbl(mySheet.Cells(personBeginRow, 5)) + CDbl(mySheet.Cells(personBeginRow, 6))
            
            Call WriteToTable("SheetSum", mySheet.Cells(personBeginRow, 3), mySheet.Cells(personBeginRow, 4), CStr(mySheet.Cells(personBeginRow, 1)), mySheet.Cells(i, sumCol))
            
            mySum = CDbl(0)
            
            For j = i To endRow
                If (mySheet.Cells(j, 2) <> 0 And (mySheet.Cells(j, 2)) <> 0) Then
                    personBeginRow = j
                    bigMonth = mySheet.Cells(j, 2)
                    Exit For
                End If
            Next
        End If
    Next
End Sub


'把计算后的结果写入另一个表中
Sub WriteToTable(sheetName As String, strName As String, strCardID As String, strYear As String, all As Double)

    
    Dim aSheet As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim curRow As Double
    Dim flag As Boolean
    
    flag = False
    
   
    Set aSheet = Application.ActiveWorkbook.Sheets(sheetName)
    
    'curRow = aSheet.Cells(Rows.Count, 1).End(1).Row
    '需要表中的数据没有用过的,要整行的删除,这样保证数据的连续性,不能只删除数据内容
    curRow = aSheet.UsedRange.Rows.Count
        For i = 4 To curRow
            If (aSheet.Cells(i, 12) = strCardID) Then
                For j = 1 To 30
                    If CStr(aSheet.Cells(2, j)) = strYear Then
                        aSheet.Cells(i, j) = all
                        flag = True
                        Exit For
                    End If
                Next
            End If
        Next
        If Not flag Then
            curRow = curRow + 1
            aSheet.Cells(curRow, 2) = strName
            aSheet.Cells(curRow, 12) = strCardID
            aSheet.Cells(curRow, 1) = curRow
            For j = 1 To 30
                If CStr(aSheet.Cells(2, j)) = strYear Then
                    aSheet.Cells(curRow, j) = all
                    Exit For
                End If
            Next
        End If
End Sub

'在每个人的信息后插入一空行,用于做总和
'插入是以个人的身份证是不是一样来判断的
'这里面要数据是连续的,如果下一个为空则认为是身份证号不一样会插入一空行
Sub InsertRow(sheetName As String, personCol As Integer)
    Dim rng As Range
    Dim personRow As String
    Dim r As Integer
    Dim n As Integer
    Dim lastRow As Integer
    
    Dim mySheet As Worksheet
    Set mySheet = Application.ActiveWorkbook.Sheets(sheetName)
    
    '第三列,即人名列最大的单元格数
    lastRow = mySheet.Cells(Rows.Count, 1).End(3).Row
    For r = lastRow - 1 To 3 Step -1
        If (mySheet.Cells(r, personCol) <> mySheet.Cells(r - 1, personCol)) Then
            mySheet.Cells(r, 1).EntireRow.Insert
        End If
        'For n = 1 To Cells(r - 1, 1).Value
        '    Cells(r, 1).EntireRow.Insert
        'Next n
    Next r
End Sub