Excel VBA之行列操作-叶海峰
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


Excel VBA之行列操作

发表时间:2012/8/1 9:01:51 评论(0) 浏览(14289)  评论 | 加入收藏 | 复制
   
摘 要: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

 


Access软件网交流QQ群(群号:198465573)
 
 相关文章
Excel vba一次性删除简短代码  【欢乐小爪  2011/9/17】
完全手册Excel VBA典型实例大全—通过368个例子掌握vba  【收藏整理  2012/7/29】
Excel VBA之合并单元格操作  【叶海峰  2012/8/8】
Excel VBA之快速列重排  【叶海峰  2012/8/22】
Excel VBA之懒人Vlookup  【叶海峰  2012/8/23】
常见问答
技术分类
相关资源
文章搜索
关于作者

叶海峰

文章分类

文章存档

友情链接