VBA 基础知识整理(单元格，表，工作簿)

'1、工作簿

       Workbooks 代表工作簿集合，所有的工作簿,Workbooks(N)，表示已打开的第N个工作簿
       Workbooks ("工作簿名称")
       ActiveWorkbook 正在操作的工作簿
       ThisWorkBook '代码所在的工作簿

'2、工作表

        ' 'Sheets("工作表名称")
          'Sheet2.UsedRange 工作表已使用单元格集合
          'Sheet1 表示第一个插入的工作表,Sheet2表示第二个插入的工作表....
          'Sheets(n) 表示按排列顺序，第n个工作表
          'Sheets(1).Name = "工作表改名了"
          'ActiveSheet 表示活动工作表，光标所在工作表
          'worksheet 也表示工作表，但不包括图表工作表、宏工作表等。
          'Sheet1.Move before:=Sheets("Sheet3")  工作表移动到“”之前
          'Sheet1.Move after:=Sheets(worksheets.count) 工作表移动到所有表最后

'3、单元格

           'cells 所有单元格
           'Range("A1").CurrentRegion 单元格所在区域连续的单元格集合
           'Range ("单元格地址")
           'Cells(行数,列数)
           'Activecell 正在选中或编辑的单元格
           'Selection 正被选中或选取的单元格或单元格区域
          ' Range("A2").Interior.ColorIndex = 3  单元格背景色3-8

'1、用VBA在单元格中输入普通公式

 Sub t1()
   Range("d2") = "=b2*c2"
 End Sub

'2、用VBA在单元格输入带引号的公式

 Sub t3()
 
 Range("c16") = "=SUMIF(A2:A6,""b"",B2:B6)" '遇到单引号就把单引号加倍
 
 End Sub

'3、用VBA在单元格中输入数组公式

Sub t4()
  Range("c9").FormulaArray = "=SUM(B2:B6*C2:C6)"
End Sub

二、利用单元格公式返回值

 Sub t5()
     Range("d16") = Evaluate("=SUMIF(A2:A6,""b"",B2:B6)")
     Range("d9") = Evaluate("=SUM(B2:B6*C2:C6)")
 End Sub

三、借用工作表函数

 Sub t6()
     Range("d8") = Application.WorksheeFunction.CountIf(Range("A1:A10"), "B")
 End Sub

'立即窗口可以把运行过程中的值立即显示出来，主要用于程序的调试

Sub d()
 Dim x As Integer, st As String
 For x = 1 To 10
    st = st & Cells(x, 1)
    Debug.Print "第" & x & "次运行结果:" _
    & st
    Debug.Print x
 Next x
End Sub

'一、END语句

  '作用：强制退出所有正在运行的程序。

'二、Exit语句

  '退出指定的语句
1、Exit Sub
2、Exit function
3、Exit for
4、Exit do

on error resume next '遇到错误,跳过继续执行下一句
on error goto 0 '取消错误跳转

'on error goto '出错时跳到指定的行数

  Sub t4()
      On Error GoTo 100
      Dim x As Integer
      
      For x = 1 To 10
        Cells(x, 3) = Cells(x, 2) * Cells(x, 1)
      Next x
      
       Exit Sub
    100:
       MsgBox "在第" & x & "行出错了"
  End Sub

---

'excel文件和工作簿

'excel文件就是excel工作簿，excel文件打开需要excel程的支持
'Workbooks 工作簿集合，泛指excel文件或工作簿
'Workbooks(“A.xls”)，名称为A的excel工作簿

'ActiveWorkbook ，当打开多个excel工作簿时，正在操作的那个就是 ActiveWorkbook（活动工作簿）

'Thisworkbook，VBA程序所在的工作簿，无论你打开多少个工作簿，无论当前是哪个工作簿是活动的,thisworkbook就是指它所在的工作簿。

'Windows(“A.xls”),A工作簿的窗口，使用windows可以设置工作簿窗口的状态，如是否隐藏等。

 Sub t3()
 	Windows("e:/A.xls").Visible = False
 End Sub
  ActiveWindow.VisibleRange.Top 活动窗体的可见单元格区域的top位置

工作表操作

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

Sub s1()
 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 s2()
     Dim sh As Worksheet
     Set sh = Sheets.Add
       sh.Name = "模板"
       sh.Range("a1") = 100
  End Sub

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

 Sub s3()
    Sheets(2).Visible = True
 End Sub

'4 excel工作表的移动

  Sub s4()
     Sheets("Sheet2").Move before:=Sheets("sheet1") 'sheet2移动到sheet1前面
     Sheets("Sheet1").Move after:=Sheets(Sheets.Count) 'sheet1移动到所有工作表的最后面
   End Sub

'6 excel工作表的复制

   Sub s5() '在本工作簿中
      Dim sh As Worksheet
      Sheets("模板").Copy before:=Sheets(1)
       Set sh = ActiveSheet
          sh.Name = "1日"
          sh.Range("a1") = "测试"
   End Sub`在这里插入代码片`

Sub s6() '另存为新工作簿

  Sub s6() '另存为新工作簿
      Dim wb As Workbook
       Sheets("模板").Copy
       Set wb = ActiveWorkbook
          wb.SaveAs ThisWorkbook.Path & "/1日.xls"
          wb.Sheets(1).Range("b1") = "测试"
          wb.Close True
   End Sub

'7 保护工作表

  Sub s7()
      Sheets("sheet2").Protect "123"
   End Sub
   Sub s8() '判断工作表是否添加了保护密码
      If Sheets("sheet2").ProtectContents = True Then
        MsgBox "工作簿保护了"
      Else
        MsgBox "工作簿没有添加保护"
      End If
   End Sub

'8 工作表删除

 Sub s9()
   Application.DisplayAlerts = False
     Sheets("模板").Delete
   Application.DisplayAlerts = True
 End Sub

'9 工作表的选取

Sub s10()
   Sheets("sheet2").Select
End Sub

单元格操作

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

 Sub s()
   Range("a1").Select
   Cells(1, 1).Select
   Range("A" & 1).Select
   Cells(1, "A").Select
   Cells(1).Select
   [a1].Select
 End Sub

'2 表示相邻单元格区域

  Sub d() '选取单元格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 d1()
      Range("a1,c1:f4,a7").Activate
      Union(Range("a1"), Range("c1:f4"), Range("a7")).Activate
End Sub

Sub dd() 'union示例
  Dim rg As Range, x As Integer
  For x = 2 To 10 Step 2
    If x = 2 Then
        Set rg = Cells(x, 1)  'rg初始化，不然rg=nothing
    Else
        Set rg = Union(rg, Cells(x, 1))
    End If
  Next x
  rg.Select
End Sub

'4 表示行

Sub h()
      Rows(1).Select
      Rows("3:7").Select
      Range("1:2,4:5").Select
      Range("c4:f5").EntireRow.Select
      Range("A1").EntireRow.Select
End Sub

'5 表示列

Sub L()
      Dim first As Range, second As Range
      
      Columns(1).Select
      Columns("A:B").Select
      Range("A:B,D:E").Select
      Set first = Range("c4:f5").EntireRow '选取c4:f5所在的行
      Set second = Range("A1").EntireColumn '选取A1所在的列
      Union(first, second).Select
End Sub

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

Sub cc()
  Range("b2").Range("a1") = 100
  cells.Cells(1,1)
End Sub

特殊单元格定位

'1 已使用的单元格区域

 Sub d1()
  
    Sheets("sheet2").UsedRange.Select
    
    wb.Sheets(1).Range("a1:a10").Copy Range("i1")
    
  End Sub

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

   Sub d2()
    
      Range("b8").CurrentRegion.Select
    
   End Sub

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

Sub d3()
 
	 Intersect(Columns("b:c"), Rows("3:5")).Select
  
End Sub

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

Sub d4()

   Range("A1:A6").SpecialCells(xlCellTypeBlanks).Select
   Range("B1:B6").SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 4
   
End Sub

'5 端点单元格

 Sub d5()
   
     Range("a65536").End(xlUp).Offset(1, 0) = 1000
     Range("A1").End(xlToRight).End(xlDown).Select
     
   End Sub

单元格信息

'1 单元格的值

  Sub x1()
    Range("b10") = Range("c2").Value
    Range("b11") = Range("c2").Text
    Range("c10") = "'" & Range("I3").Formula
  End Sub

'2 单元格的地址

Sub x2()
 With Range("b2").CurrentRegion
   [b12] = .Address
   [c12] = .Address(0, 0)
 End With
End Sub

'3 单元格的行列信息

Sub x3()
  With Range("b2").CurrentRegion
    [b13] = .Row
    [b14] = .Rows.Count
    [b15] = .Column
    [b16] = .Columns.Count
    [b17] = .Range("a1").Address
  End With
End Sub

'4、单元格的格式信息

Sub x4()
  With Range("b2")
    [b19] = .Font.Size
    [b20] = .Font.ColorIndex
    [b21] = .Interior.ColorIndex
    [b22] = .Borders.LineStyle
  End With
End Sub

'5、单元格批注信息

  Sub x5()
        [B24] = Range("I2").Comment.Text
  End Sub

'6 单元格的位置信息

Sub x6()
    With Range("b3")
      [b26] = .Top
      [b27] = .Left
      [b28] = .Height
      [b29] = .Width
    End With
End Sub

'7 单元格的上级信息

 Sub x7()
      With Range("b3")
        [b31] = .Parent.Name
        [b32] = .Parent.Parent.Name
      End With
 End Sub

'8 内容判断

  Sub x8()
   With Range("i3")
    [b34] = .HasFormula
    [b35] = .Hyperlinks.Count
   End With
  End Sub

单元格格式

'1 判断是否为空单元格

Sub d1()
   [b1] = ""
   If Range("a1") = "" Then
   If Len([a1]) = 0 Then
   
   If VBA.IsEmpty([a1]) Then
      [b1] = "空值"
   End If
End Sub

'2 判断是否为数字

  Sub d2()
      [b2] = ""
      If VBA.IsNumeric([a2]) And [a2] <> "" Then
      
      If Application.WorksheetFunction.IsNumber([a2]) Then
        [b2] = "数字"
      End If
  End Sub

'3 判断是否为文本

Sub d3()
  [b3] = ""
   If Application.WorksheetFunction.IsText([A3]) Then
   If VBA.TypeName([a3].Value) = "String" Then
     [b3] = "文本"
  End If
End Sub

'4 判断是否为汉字

   Sub d4()
        [b4] = ""
        If [a4] > "z" Then
          [b4] = "汉字"
        End If
   End Sub

'5 判断错误值

Sub d10()
      [b5] = ""
      If VBA.IsError([a5]) Then
      If Application.WorksheetFunction.IsError([a5]) Then
         [b5] = "错误值"
      End If
End Sub

Sub d11()
      [b6] = ""
      If VBA.IsDate([a6]) Then
         [b6] = "日期"
      End If
End Sub

'二、设置单元格自定义格式

   Sub d30()
        Range("d1:d8").NumberFormatLocal = "0.00"
   End Sub

'三、按指定格式从单元格返回数值

   Format函数语法(和工作表数Text用法基本一致)
   
   Format(数值,自定义格式代码)

合并单元格

'单元格合并

Sub h1()
    Range("g1:h3").Merge
    range.UnMerge 
End Sub

'合并区域的返回信息

  Sub h2()
        Range("e1") = Range("b3").MergeArea.Address '返回合并单元格地址
  End Sub

'判断是否含合并单元格 MergeCells

Sub h3()
    MsgBox Range("b2").MergeCells  ’在合并单元格中，返回true
    MsgBox Range("A1:D7").MergeCells ' 不在合并单元格中，返回false
    Range("e2") = IsNull(Range("a1:d7").MergeCells) '部分合并单元格，返回null
    Range("e3") = IsNull(Range("a9:d72").MergeCells)
End Sub

'综合示例

'合并H列相同单元格

 Sub h4()
  Dim x As Integer
  Dim rg As Range
  Set rg = Range("h1")   '初始化
  Application.DisplayAlerts = False
  
  For x = 1 To 13
      If Range("h" & x + 1) = Range("h" & x) Then
      	 Set rg = Union(rg, Range("h" & x + 1))
      Else
         rg.Merge
         Set rg = Range("h" & x + 1)
      End If
  Next x
  Application.DisplayAlerts = True
 End Sub

单元格编辑

'1 单元格输入

Sub t1()
  Range("a1") = "a" & "b"
  Range("b1") = "a" & Chr(10) & "b" '换行答输入
End Sub

'2 单元格复制和剪切

  Sub t2()
    Range("a1:a10").Copy Range("c1") 'A1：A10的内容复制到C1起点
  End Sub
-------------------------------------------------------------
  Sub t3()
    Range("a1:a10").Copy
    ActiveSheet.Paste Range("d1") '粘贴至D1
  End Sub
 -----------------------------------------------------------
  Sub t4()
    Range("a1:a10").Copy
    Range("e1").PasteSpecial (xlPasteValues) '只粘贴为数值
  End Sub
  ----------------------------------------------------------
  Sub t5()
    Range("a1:a10").Cut
    ActiveSheet.Paste Range("f1") '粘贴到f1
  End Sub
 -------------------------------------------------------------
  Sub t6()
    Range("c1:c10").Copy
    Range("a1:a10").PasteSpecial Operation:=xlAdd '选择粘贴-加
  End Sub
  ------------------------------------------------------------
  Sub T7()
      Range("G1:G10") = Range("A1:A10").Value
  End Sub

'3 填充公式

 Sub T8()
      Range("b1") = "=a1*10"
      Range("b1:b10").FillDown '向下填充公式
 End Sub

单元格行列的删除和插入

Sub c1()
  Rows(4).Insert
End Sub
-----------------------------------------------------------------

Sub c2() '插入行并复制公式
  Rows(4).Insert
  Rows("12:14").Insert
  Range("3:4").FillDown
  Range("4:4").SpecialCells(xlCellTypeConstants) = ""
End Sub
 -----------------------------------------------------------------

Sub c3()
  Dim x As Integer
  For x = 2 To 20
    If Cells(x, 3) <> Cells(x + 1, 3) Then
      Rows(x + 1).Insert
      x = x + 1
    End If
  Next x
End Sub
 -----------------------------------------------------------------

Sub c4()
  Dim x As Integer, m1 As Integer, m2 As Integer
  Dim k As Integer
  m1 = 2
  For x = 2 To 1000   '在范围内
    If Cells(x, 1) = "" Then Exit Sub  ‘单元格为空，过程结束
    If Cells(x, 3) <> Cells(x + 1, 3) Then ’如果当前单元格不等于下个单元格
      m2 = x	 ‘记录下当前单元格行数
      Rows(x + 1).Insert  	‘在下一单元格前面插入一行
      Cells(x + 1, "c") = Cells(x, "c") & " 小计" 		’编辑下插入一行的单元格内容
      Cells(x + 1, "h") = "=sum(h" & m1 & ":h" & m2 & ")" 	’起始单元格到结尾单元格相加
      Cells(x + 1, "h").Resize(1, 4).FillRight	‘插入的单元格向右填充公式
      Cells(x + 1, "i") = ""		‘插入的一个单元格清空
      x = x + 1		‘跨过插入单元格，再次循环
      m1 = m2 + 2   ‘跨过插入单元格，再次循环
    End If
  Next x
End Sub
----------------------------------------------------------------
Sub dd() '删除小计行
 	Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

单元格查询
'1 使用循环查找 (在单元格中查找效率太低)

'2 调用工作表函数

Sub c1() '判断是否存在,并查找所在行数
      Dim hao As Integer
      Dim icount As Integer
      icount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])
      If icount > 0 Then
	       MsgBox "该入库单号码已经存在，请不要重复录入"
	       MsgBox Application.WorksheetFunction.Match([g3], Sheets("库存明细表").[b:b], 0)
      End If
End Sub
  -----------------------------------------------------------

'3 使用Find方法

Sub c2()
      Dim r As Integer, r1 As Integer
      Dim icount As Integer
      icount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])
      If icount > 0 Then
       r = Sheets("库存明细表").[b:b].Find(Range("G3"), Lookat:=xlWhole).Row '查找号码第一次出现的位置
       r1 = Sheets("库存明细表").[b:b].Find([g3], , , , , xlPrevious).Row
       MsgBox r & ":" & r1
      End If
End Sub

	------------------------------------------------------


Sub c3() '返回最下一行非空行的行数
    
      MsgBox Sheets("库存明细表").Cells.Find("*", , , , , xlPrevious).Row
    
   End Sub
 -----------------------------------------------------

入库单实例

Sub 输入()
  Dim c As Integer   '号码在库存表中的个数
  Dim r As Integer   '入库单的数据行数
  Dim cr As Integer  '库存明细表中第一个空行的行数
With Sheets("库存明细表")
    c = Application.CountIf(.[b:b], Range("g3"))
    If c > 0 Then
       MsgBox "该单据号码已经存在！,请不要重复录入"
       Exit Sub
    Else
       r = Application.CountIf(Range("b6:b10"), "<>")
       cr = .[b65536].End(xlUp).Row + 1
       .Cells(cr, 1).Resize(r, 1) = Range("e3")
       .Cells(cr, 2).Resize(r, 1) = Range("g3")
       .Cells(cr, 3).Resize(r, 1) = Range("c3")
       .Cells(cr, 4).Resize(r, 6) = Cells(6, 2).Resize(r, 6).Value
       MsgBox "输入已完成"
    End If
 End With
End Sub
------------------------------------------------------------
Sub 查找()
  Dim c As Integer   '号码在库存表中的个数
  Dim r As Integer   '入库单的数据行数
  
With Sheets("库存明细表")
    c = Application.CountIf(.[b:b], Range("g3"))
    If c = 0 Then
       MsgBox "该单据号码不存在！"
       Exit Sub
    Else
        r = .[b:b].Find(Range("g3"), , , , , xlNext).Row
        Range("c3") = .Cells(r, 3)
        Range("e3") = .Cells(r, 1)
        Cells(6, 2).Resize(c, 5) = .Cells(r, 4).Resize(c, 5).Value
       MsgBox "查询已完成"
    End If
 End With
End Sub
-----------------------------------------------------------
Sub 删除()
 Dim c As Integer   '号码在库存表中的个数
  Dim r As Integer   '入库单的数据行数
  
With Sheets("库存明细表")
    c = Application.CountIf(.[b:b], Range("g3"))
    If c = 0 Then
       MsgBox "该单据号码不存在！"
       Exit Sub
    Else
        r = .[b:b].Find(Range("g3"), , , , , xlNext).Row
        .Range(r & ":" & c + r - 1).Delete
       MsgBox "删除已完成"
    End If
 End With
End Sub
Sub 修改()
  Call 删除
  Call 输入
End Sub