Excel VBA之行列操作

时　间:2012-08-01 09:01:51
作　者:叶海峰   ID：31  城市：广州
摘　要:Excel VBA之行列操作
正　文:

Sub insert()    '批量插入列（行）
    On Error GoTo tuichu
    Dim i      As Integer
    i = InputBox("插入列请以1开头加列数，插入行为2开头", "插入空白列（行）", "")
    Application.ScreenUpdating = False
    If Left(i, 1) = "1" Then
        For i = 1 To Right(i, Len(i) - 1)
            ActiveCell.Select
            Selection.Columns().EntireColumn.insert
        Next
    End If
    If Left(i, 1) = 2 Then
        For i = 1 To Right(i, Len(i) - 1)
            ActiveCell.Select
            Selection.Rows().EntireRow.insert
        Next
    End If
    Application.ScreenUpdating = True
tuichu:
End Sub

Sub insertrow()
    Dim rcount As Integer
    Dim i      As Integer
    Dim Q      As Byte
    Dim k      As Byte
    Dim j      As Byte
    j = InputBox("请输入相隔的行数")
    Q = InputBox("请输入插入行数")
    rcount = Selection.Rows.count
    For i = 1 To Int(rcount / j)
        For k = 1 To Q
            ActiveCell.Offset(j, 0).Rows().EntireRow.insert
        Next
        ActiveCell.Offset(j + Q, 0).Select
    Next
End Sub

Sub insertcol()    '自动每隔N列插入一空白列
'On Error GoTo tuichu
    Dim i, ii, a As Integer
   Application.ScreenUpdating = False
    i = InputBox("请输入相隔列数", "", 1)
    ii = Selection.Columns.count
    ActiveCell.Offset(0, i).Select
    Selection.Columns().EntireColumn.insert
    For a = 2 To Int(ii / i)
        ActiveCell.Offset(0, i + 1).Select
        Selection.Columns().EntireColumn.insert
    Next
    Application.ScreenUpdating = True
tuichu:
End Sub

Sub quick_up_sum()    '所选范围内空白单元格自动向上小计
    Dim col, row, count As Integer
    Dim rng1   As String
    Application.ScreenUpdating = False
    On Error GoTo tuichu
    col = Selection.Columns.count
    row = Selection.Rows.count - 1
    For i = 1 To col
        Range(ActiveCell, ActiveCell.Offset(row, 0)).Select
        For Each rng In Selection
            If rng.Value <> "" Then
                count = count - 1
            Else
                rng.Value = "=sum(" & rng.Offset(count, 0).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
                            ":" & rng.Offset(-1, 0).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
                '  Range(rng.Address, rng.Offset(0, col)).FillRight
                rng1 = rng1 & "," & rng.Address    '& ":" & rng.Offset(0, col).Address
                count = 0
            End If
        Next
        ActiveCell.Offset(0, 1).Select
    Next i
    Range(Right(rng1, Len(rng1) - 1)).Select
    Selection.Font.Bold = True
    Selection.interior.ColorIndex = 37
    '.Pattern = xlSolid
    Application.ScreenUpdating = True
tuichu:
End Sub

Sub quick_left_sum()    '所选范围内空白单元格自动向左小计
    Dim col, row, count As Integer
    Dim rng1   As String
    Application.ScreenUpdating = False
    On Error GoTo tuichu
    col = Selection.Columns.count - 1
    row = Selection.Rows.count - 1
    ' For i = 1 To row
    Range(ActiveCell, ActiveCell.Offset(0, col)).Select
    For Each rng In Selection
        If rng.Value <> "" Then
            count = count - 1
        Else
            rng.Value = "=sum(" & rng.Offset(0, count).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
                        ":" & rng.Offset(0, -1).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
            Range(rng.Address, rng.Offset(row, 0)).FillDown
            rng1 = rng1 & "," & rng.Address & ";" & rng.Offset(row, 0).Address
            count = 0
        End If
    Next
    'ActiveCell.Offset(1, 0).Select
    'Next i
    Range(Right(rng1, Len(rng1) - 1)).Select
    Selection.Font.Bold = True
    Selection.interior.ColorIndex = 37
    Application.ScreenUpdating = True
tuichu:
End Sub

Sub mid_sum()    '所选范围内相隔N列或行合计数
    Dim col    As Integer
    Dim rng1   As String
    On Error GoTo tuichu
    col = InputBox("请输入相隔列或行数,所选范围为1行,将默认列合计,相反为行合计", , 2)
    rng1 = ""
    If Selection.Rows.count = 1 Then
        For i = 1 To Selection.Columns.count Step col
            rng1 = rng1 & "," & ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
            ActiveCell.Offset(0, col).Select
        Next i
    Else
        For i = 1 To Selection.Rows.count Step col
            rng1 = rng1 & "," & ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
            ActiveCell.Offset(col, 0).Select
        Next i
    End If
    ActiveCell.Value = "=sum(" & Right(rng1, Len(rng1) - 1) & ")"
tuichu:
End Sub