VBA学习笔记2-文件打开、保存、备份、关闭等；工作表选取、删除、移动等；单元格定位、格式、合并等

'excel文件和工作簿
'excel文件就是excel工作簿，excel文件打开需要excel程的支持
'Workbooks  工作簿集合，泛指excel文件或工作簿
'1. 令文件A的第1个sheet中单元格A1等于100
 Sub t1()
   Workbooks("A.xls").Sheets(1).Range("a1") = 100  'Workbooks("A.xls")，名称为A的excel工作簿
 End Sub
   
'1. 令第二个工作簿的第2个sheet中单元格A1等于200
 Sub t2()
   Workbooks(2).Sheets(2).Range("a1") = 200  'workbooks(2)，按打开顺序，第二个打开的工作簿
 End Sub

'ActiveWorkbook ：当打开多个excel工作簿时，你正在操作的那个就是ActiveWorkbook（活动工作簿）
   
'Thisworkbook：VBA程序所在的工作簿，无论你打开多少个工作簿，无论当前是哪个工作簿是活动的,thisworkbook就是指它所在的工作簿

'工作簿窗口
'Windows("A.xls"),A工作簿的窗口，使用windows可以设置工作簿窗口的状态，如是否隐藏等。
'1. 隐藏工作簿A
 Sub t3()
   Windows("A.xls").Visible = False
 End Sub

'2. 取消隐藏第二个sheet
 Sub t4()
   Sheets(2).Visible = True
 End Sub

'3. 判断A.Xls文件是否存在
 Sub W1()
   If Len(Dir("d:/A.xls")) = 0 Then
     MsgBox "A文件不存在"
   Else
     MsgBox "A文件存在"
   End If
 End Sub

'4. 判断A.Xls文件是否打开
 Sub W2()
   Dim X As Integer
     For X = 1 To Windows.Count
       If Windows(X).Caption = "A.XLS" Then
         MsgBox "A文件打开了"
         Exit Sub
       End If
     Next
 End Sub
   
'5. excel文件新建和保存
 Sub W3()
   Dim wb As Workbook
    Set wb = Workbooks.Add
      wb.Sheets("sheet1").Range("a1") = "abcd"
    wb.SaveAs "D:/B.xls"
 End Sub


'6. excel文件打开和关闭
 Sub w4()
   Dim wb As Workbook
    Set wb = Workbooks.Open("D:/B.xls")
    MsgBox wb.Sheets("sheet1").Range("a1").Value
    wb.Close False  '关闭工作簿且不保存
 End Sub

'7. excel文件保存和备份
 Sub w5()
   Dim wb As Workbook
     Set wb = ThisWorkbook
     wb.Save
     wb.SaveCopyAs "D:/ABC.xls"
 End Sub
  
'8. excel工作表的移动
   Sub s4()
     Sheets("Sheet2").Move before:=Sheets("sheet1") 'sheet2移动到sheet1前面
     Sheets("Sheet1").Move after:=Sheets(Sheets.Count) 'sheet1移动到所有工作表的最后面
   End Sub  

'9. 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() '另存为新工作簿
   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

'10. 工作表删除
     Sub s9()
       Application.DisplayAlerts = False  '不显示删除时提示的提示框
         Sheets("模板").Delete
       Application.DisplayAlerts = True
     End Sub

'11. 工作表的选取
     Sub s10()
       Sheets("sheet2").Select
     End Sub

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

'单元格选取
'1. 表示一个单元格(a1)
 Sub s()
   'Range("a1").Select  '方法1
   'Cells(1, 1).Select  '方法2
   'Range("A" & 1).Select  '方法3
   'Cells(1, "A").Select  '方法4
   'Cells(1).Select  '方法5
   [a1].Select  '方法6
 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  '以A1为起点的总行数和总列数
   End Sub
   
'3. 表示不相邻的单元格区域
 Sub d1()
   Range("a1,c1:f4,a7").Select
   'Union(Range("a1"), Range("c1:f4"), Range("a7")).Select  '选取多个单元格
 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)
     Set rg = Union(rg, Cells(x, 1))
   Next x
   rg.Select
 End Sub
    
'4. 表示行
 Sub h()
   'Rows(1).Select
   'Rows("3:7").Select  '第3到7行
   'Range("1:2,4:5").Select  '第1到2行和4到5行，即选取不连续的行
    Range("c4:f5").EntireRow.Select  '选取单元格C4:F5所在的行
 End Sub
    
'5. 表示列
 Sub L()
   'Columns(1).Select
   'Columns("A:B").Select
   'Range("A:B,D:E").Select
    Range("c4:f5").EntireColumn.Select  '选取c4:f5所在的列
 End Sub

'6. 重置坐标，新坐标系以B2为起点 
 Sub cc()
   Range("b2").Range("a1") = 100  
 End Sub
    
'7. 将正在选取的单元格区域内容改为100
 Sub d2()
   Selection.Value = 100
 End Sub

'特殊单元格定位
'1. 选取sheet2已使用的单元格区域
 Sub d1()
   Sheets("sheet2").UsedRange.Select  
  'wb.Sheets(1).Range("a1:a10").Copy Range("i1")
 End Sub

'2. 选取B8所在的已使用的单元格区域
 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  '选取空单元格
 End Sub
    
'5. 端点单元格
 Sub d5()
   Range("a65536").End(xlUp).Offset(1, 0) = 1000  '类似于Ctrl+向上键
 End Sub
  
 Sub d6()
   Range(Range("b6"), Range("b6").End(xlToRight)).Select
 End Sub

'单元格信息
'1. 单元格的值
 Sub x1()
   Range("b10") = Range("c2").Value
   Range("b11") = Range("c2").Text
   Range("c10") = "'" & Range("b2").Formula  'Formula表示返回的是公式
 End Sub

'2. 单元格的地址
 Sub x2()
   With Range("b2").CurrentRegion
      [b12] = .Address       '绝对地址
      [c12] = .Address(0, 0) '相对地址
      [d12] = .Address(1, 0) '列相对，行绝对
      [e12] = .Address(0, 1) '行相对，列绝对
      [f12] = .Address(1, 1) '绝对地址，两个1可省略
   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("b2")
      [b26] = .Top
      [b27] = .Left
      [b28] = .Height
      [b29] = .Width
   End With
 End Sub

'7. 单元格的上级信息
 Sub x7()
   With Range("b2")
      [b31] = .Parent.Name '所在工作表名称
      [b32] = .Parent.Parent.Name '所在工作表的所在工作簿名称
   End With
 End Sub

'8. 内容判断
 Sub x8()
   With Range("b2")
      [b34] = .HasFormula '是否有公式
      [b35] = .Hyperlinks.Count '超链接个数
   End With
 End Sub

'单元格格式
'1. Excel中的颜色可以用两种方式获取，一种是EXCEL内置颜色，另一种是利用QBCOLOR函数返回
 Sub y1()
   Dim x As Integer
   Range("a1:b60").Clear
   For x = 1 To 56
     Range("a" & x) = x
     Range("b" & x).Font.ColorIndex = 3
   Next x
 End Sub

 Sub y2()
   Dim x As Integer
   For x = 0 To 15
     Range("d" & x + 1) = x
     Range("e" & x + 1).Interior.Color = QBColor(x)
   Next x
 End Sub

 Sub y3()
   Dim 红 As Integer, 绿 As Integer, 蓝 As Integer
   红 = 255
   绿 = 123
   蓝 = 100
   Range("g1").Interior.Color = RGB(红, 绿, 蓝)
 End Sub

'2. 判断数值的格式
'2.1 判断是否为空单元格
 Sub d1()
   [b1] = ""
   'If Range("a1") = "" Then
   'If Len([a1]) = 0 Then
   If VBA.IsEmpty([a1]) Then
     [b1] = "空值"
   End If
 End Sub

'2.2 判断是否为数字
 Sub d2()
   [b2] = ""
   'If VBA.IsNumeric([a2]) And [a2] <> "" Then
   If Application.WorksheetFunction.IsNumber([a2]) Then
      [b2] = "数字"
   End If
 End Sub

'2.3 判断是否为文本
 Sub d3()
   [b3] = ""
   'If Application.WorksheetFunction.IsText([A3]) Then
   If VBA.TypeName([a3].Value) = "String" Then
     [b3] = "文本"
   End If
 End Sub

'2.4 判断是否为汉字
 Sub d4()
    [b4] = ""
    If [a4] > "z" Then
      [b4] = "汉字"
    End If
 End Sub

'2.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

'3. 设置单元格自定义格式
 Sub d30()
    Range("d1:d8").NumberFormatLocal = "0.00"
 End Sub

'4. 按指定格式从单元格返回数值
'Format函数语法(和工作表数Text用法基本一致)
'Format(数值,自定义格式代码)

'5. 单元格合并
 Sub h1()
   Range("g1:h3").Merge
 End Sub
  
'5.1. 合并区域的返回信息
 Sub h2()
   Range("e1") = Range("b3").MergeArea.Address '返回单元格所在的合并单元格区域
 End Sub

'5.2. 判断是否含合并单元格
 Sub h3()
   'MsgBox Range("b2").MergeCells
   ' MsgBox Range("A1:D7").MergeCells
   Range("e2") = IsNull(Range("a1:d7").MergeCells)
   Range("e3") = IsNull(Range("a9:d72").MergeCells)
 End Sub
  
'5.3. 综合示例
'合并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

'4.插入行
 Sub c1()
   Rows(4).Insert '插入行，原单元格下移
 End Sub

 Sub c2() '插入行并复制公式
   Rows(4).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 c44() '个人方法
   Dim x As Integer
   Dim t As Integer
   t = Range("c65536").End(xlUp).Row
   For x = t To 2 Step -1
     If Cells(x, 3) <> Cells(x - 1, 3) Then
        Rows(x).Insert
        Cells(Cells(x, "C").Offset(1, 0).End(xlDown).Row + 1, "C") = Cells(Cells(x, "C").Offset(1, 0).End(xlDown).Row, "C") & " 小计"
        Cells(Cells(x, "H").Offset(1, 0).End(xlDown).Row + 1, "H") = _
        Application.Sum(Range(Cells(x, "h").Offset(1, 0), Cells(x, "H").Offset(1, 0).End(xlDown)))
     End If
   Next x
 End Sub

 Sub dd() '批量删除空行
   Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete