VBA 代码段汇集[不断的更新中]

dylan0108

能否整理成一个word档案？方便收藏学习，谢谢！

民扬

第十集 Excel工作表操作

一、Excel工作表的几个概念

1、 Excel工作表的分类

Excel工作有两大类，一类是我们平常用的工作表(worksheet),另一类是图表、宏表等。

Sheets工作表集合，泛批excel各种工作表

Sheets(“A”),名称为A的excel工作表

Sub t1()

    Sheets("A").Range("a1")= 100

End Sub

Workbooks(2)，按打开顺序，第二个打开的工作薄。

Sub t2()

    Sheets(2).Range("a1") = 200

End Sub

Activesheet,当打开多个excel时，你正在操作的那个就是activesheet。

二、excel工作表的操作

1、 判断A工作表文件是否存在

Sub 例1()

   Dim x As Integer

   For x = 1 To Sheets.Count

       If Sheets(x).Name = "A" Then

       MsgBox "A工作表存在"

       Exit Sub

   End If

   Next

   MsgBox "A工作表不存在"

End Sub

      

2、 excel工作表的插入

Sub 例2()

   Dim x As Iworksheet

   Set sh = Sheets.Add

       sh.Name = "模板"

       sh.Range("a1") = 100

End Sub

3、 excel工作表隐藏和取消隐藏

Sub 例3()

   Sheets(2).Visible = False 'true表示取消隐藏，False表示隐藏

End Sub

4、 excel工作表的移动

Sub 例4()

   Sheets("sheet2").Move before:=Sheets("sheet1")'sheet2移动到sheet1前面

   Sheets("sheet1").Move after:=Sheets(Sheets.Count) 'sheet1移动到所有工作表的最后面

End Sub

5、 excel工作表的复制

Sub 例5() ‘在本工作薄中

   Dim sh As Worksheet

    Sheets("模板").Copybefore:=Sheets(1)

      she sh = ActiveSheet

           sh.Name = "1日"

           sh.Range("a1") = "测试"

End Sub

Sub 例6() '另存为新工作薄

   Dim vb As Workbook

     Sheets("模板").Copy

     Set wb = ActiveWorkbook

           wb.SaveAs ThisWorkbook.Path & "/1日.xls"

           wb.Sheets(1).Range("b1") = "测试"

           wb.Close True

End Sub

6、 保护工作表

Sub 例7()

   Sheets("sheet2").Protect "123" '工作表2设置了密码"123"

End Sub

Sub 例8() '判断工作表是否添加了保护密码

    IfSheets("sheet2").ProtectContents = True Then

       MsgBox "工作薄保护了"

   Else

       MsgBox "工作薄没有添加保护"

   End If

End Sub

7、 工作表删除

Sub 例9()

   Application.displalerts = False '关闭弹出提示框

       Sheets("模板").Delete

   Application.displalerts = True '打开弹出提示框

End Sub

8、 工作表的选取

Sub 例10()

   Sheets("sheet2").Select

End Sub

民扬

第十一集 单元格的选取

1、 表示一个单元格(a1)

Sub 例1()

   Range("a1").Select

   Cells(1, 1).Select

   Range("A" & 1).Select

   Cells(1, "A").Select

   Cells(1).Select

   [a1].Select

End Sub

2、 表示相邻单元区域

Sub 例2() '选取单元格a1:c5

   Range("a1:c5").Select

   Range("a1", "c5").Select

   Range(Cells(1, 1), Cells(5, 3)).Select

   Range("a1:a10").Offset(0, 1).Select

   Range("a1").Resize(5, 3).Select

End Sub

3、 表示不相邻的单元格区域

Sub 例3()

   Range("a1,c1:f4,a7").Select

   Union(Range("a1"), Range("c1:f4"),Range("a7")).Select 'Union表示拼接意思

End Sub

Sub 例4() 'Union示例

   Dim rg As Range, X As Integer

   For X = 2 To 10 Step 2

       If X = 2 Then Set rg = Cells(X, 1)

       Set rg = Union(rg, Cells(X, 1))

   Next X

   rg.Select

End Sub

4、 表示行

Sub 例5()

   Rows(1).Select

   Rows("3:7").Select

   Range("1:2,4:5").Select

   Range("c4:f5").EntireRow.Select

End Sub

5、 表示例

Sub 例6()

   Columns(1).Select

   Columns("A:B").Select

   Range("A:B,D:E").Select

   Range("c4:f5").EntireColumn.Select '选取C4:F5所在的行

End Sub

6、 重置坐标下的单元格表示方法

Sub 例7()

   Range("b2").Range("a1") = 100

End Sub

Sub 例8()  '表示正在选取的单元格区域

   Selection.Value = 100

End Sub

民扬

第十二集 特殊单元格定位

1、 已使用的单元格区域

Sub 例1()

   Sheets(sheet2).UsedRange.Select

   wb.Sheets(1).Range("a1:a10").Copy Range("i1")

End Sub

2、 某单元格所在的单元格区域

Sub 例2()

   Range("b8").CurrentRegion.Select

End Sub

3、 两个单元格区域共同的区域

Sub 例3()

   Application.Intersect(coluens("b:c"),Rows("3:5")).Select

End Sub

4、 调用定位条件选取特殊单元格

Sub 例4()

   Range("A1:A6").SpecialCells(xlCellTypeBlanks).Select

End Sub

5、 端点单元格

Sub 例5()

  Range("a65536").End(xlUp).Offset(1, 0) = 1000

End Sub

Sub 例6()

  Range(Range("b6"),Range("b6").End(xlToRight)).Select

End Sub

shaokui123

以上已收集，谢谢

流浪雨

基础知识学习，对新手来说就是宝，谢谢楼主

15964318726

感谢分享！！！！

民扬

Sub test() '在某列空白单元内赋予数值

Set sh = ActiveSheet

i = 1
Text = 1 'Text = sh.Cells(i, 1)等于上个单元值
'从第二行开始
For i = 2 To 600 '最大行数
    If Trim(sh.Cells(i, 4)) = "" Then
        sh.Cells(i, 4) = Text
    Else
        Text = 1 'Text = sh.Cells(i, 1)等于上个单元值
    End If
Next i

End Sub

民扬

Sub 统计()
    Dim n As Integer
    n = WorksheetFunction.CountIf(Range("A:A"), "李强")
    MsgBox "A列中李强的个数为：" & n
End Sub

Sub 统计2()
    Dim i As Integer
    Dim r As Integer, n As Integer
    Dim str, rng
    str = Application.InputBox(prompt:="请输入要在A列中统计的姓名:", Default:="李强", Type:=2)
    str = Trim(str)
    r = Cells(Rows.Count, 1).End(xlUp).Row
    rng = Range("A1:A" & r)
    For i = 1 To r
        If Trim(rng(i, 1)) = str Then n = n + 1
    Next i
    MsgBox "A列中" & str & "的个数为：" & n
End Sub
Sub 随机数()
    Dim nRow As Integer, nCol As Integer
    Dim nVal As Integer, sVal As String
    Dim vData As Variant, y
    Application.ScreenUpdating = False '关闭屏幕刷新
    y = [aa65536].End(3).Row + 1 'A列最后一行
     Sheets("sheet1").Range("aa2:bw" & y & "").ClearContents '清空单元格内容
    ReDim vData(1 To 32500, 1 To 15)
    For nRow = 1 To 32500
        sVal = "|0|"
        nVal = 0
        For nCol = 1 To 15
            Do While sVal Like "*|" & nVal & "|*"
                nVal = Int(Rnd * 50)
            Loop
            vData(nRow, nCol) = nVal
            sVal = sVal & nVal & "|"
        Next
    Next
    [A1:o32500] = vData
    With Sheet1
       Dim n As Integer, a1a, a2b, a3c, a4d, a5e, a6f
    a1a = 1
    a2b = 2
    a5e = 1
    a6f = 10
For a4d = 1 To 3250
    If a4d > 3250 Then Exit Sub
    For n = a1a To 49
        If a1a > 49 Then GoTo 100:
    n = WorksheetFunction.CountIf(Range("A" & a5e & ":o" & a6f), a1a)
    Cells(a2b, 26 + a1a) = n
    a1a = a1a + 1

    Next n
100:
    a1a = 1
    a2b = a2b + 1
    a5e = a5e + 10
    a6f = a6f + 10
    Next a4d

Dim y1y As Integer, b1a, b2b, b3c, b4d, b5e, b6f
Application.ScreenUpdating = False '关闭屏幕刷新
b3c = b3c + 3
    For b1a = 2 To 326

        For y1y = 2 To 12
        If y1y > 13 Then Exit Sub
b3c = b3c + 1
If y1y = 10 Then '第10行插入
    Range("AA" & b3c & ":BW" & b3c & "").Select ' 指定区域插入行
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
    Next y1y
    Next b1a
    End With
Application.ScreenUpdating = True '打开屏幕刷新
MsgBox Format(Timer - tms, 完成时间 & "0.0000s")

End Sub

snyn168

好东西，支撑下。。。。