operating workbook

目录

• operating workbook
• FOR循环
  • 普通FOR循环
  • FOR进阶
  • each的局限性
• workbooks
• 大题
  • sheet copy
  • 综合大题

operating workbook

FOR循环

普通FOR循环

例题：利用VBA，填充表格内的a1到a10，a1=1，a2=2，a3=3……，以此类推。

Sub shishi()
    Dim i As Integer
    For i = 1 To 10
        Range("a" & i) = i
    Next
End Sub

这是第一种方式，还有第二种方式；

sub shishi2()
	dim ge as range
	dim i as integer
	for each ge range(a1:a10)
		i = i + 1
		ge = i
	next
end sub

那个each还有其它的适用场景吗？比如，有多个表，除了有一个叫zhanghe的表不能删除，剩下的表我们都要删除掉，如果说我们通过传统的方式用for就一直删除表1，但无法排除掉某张表，我们就可以通过each来实现，如下所示；

Sub shishi3()
Dim biao As Worksheet
Application.DisplayAlerts = False
    For Each biao In Sheets
        If biao.Name <> "zhanghe" Then
            biao.Delete
        End If
    Next
Application.DisplayAlerts = True

End Sub

biao在这里也是一个范围，不过不能写range了，而要写成worksheet，这个wordsheet就是指工作表。

biao的赋值是sheets，意思就是每一个工作表，如果biao的名字不等于zhanghe，那就删除

FOR进阶

让我们来看这一样的案例，在一列当中有很多数据，有的单元格里面有数值，有的单元格里面没有数值，我们想用for循环删除有空单元格的行，这个案例应该怎么写呢？如下所示：

Sub shishi()
    Dim i As Integer
    For i = 1 To 10
        If Range("a" & i) = "" Then
            Range("a" & i).Select
            Selection.EntireRow.Delete
        End If
    Next
End Sub

其实上面这个小例子非常好理解，就是判断一下a列的单元格是否有空单元格，如果有的话，就将一整行给删除，但有一个点需要注意，我们在删除一整行之前要先选中某一个单元格，实际上选中的单元格并删除这两句代码是我通过录制宏做出来的，最好我们要自己写出来。

上面这个小案例其实是有问题的，问题是一旦遇到两个连续的空单元格，当我们删除了第一个之后，第二个会自动向上移动一行，就会逃出我们的判断，怎么办呢？可不可以从上两上删除，如果从下向上删除的话，会不会遇到这种情况呢？我们可以仔细想一想，当我们从小向上删除的时候，假如在删除第六行的空行，下方的行会向上移动，而下方的行又是已经被判断过了，不会有问题，上方的行又不会改变，所以这种方案是可行的。

Sub shishi()
    Dim i As Integer
    For i = 10 To 1 Step -1
        If Range("a" & i) = "" Then
            Range("a" & i).Select
            Selection.EntireRow.Delete
        End If
    Next
End Sub

each的局限性

从上面的例子来看，for不太擅长解决循环当中有条件判断的事物，each行吗？each也不行，而且each面对表格内部的条件判断也是不太行的，举个例子，我们想删除在一列当中的是否有空的单元格，如果有的话，将就这一行给删除，我们用for从上向下删除的时候有问题，问题就是如果有两个连续的空，就会忽略掉一个，使用for循环的话只能是从下向下删除比较好，each也做不到

workbooks

对于一个excel文件，我们可以做哪些操作呢？无非就是新建、打开、保存、关闭这几种操作。

Sub shishi()
		'在VBA操作时会屏幕闪动，这一行是用来关闭闪动的。
    Application.DisplayAlerts = false
    Application.ScreenUpdating = false
		'打开一个文件
    Workbooks.Open Filename:="c:data1.xlsx"
		'打开一上文件当中，要通过active定位到具体到哪个表格，然后给a1单元格赋值
    ActiveWorkbook.Sheets(1).Range("a1") = "zhanghe127893"
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = ture
End Sub

下面我们现来演示一个如何创建，也是相当简单

Sub chuangjian()
    Workbooks.Add
    ActiveWorkbook.Sheets(1).Range("a1") = "zhanghe"
    ActiveWorkbook.SaveAs Filename:="c:data2.xlsx"
    ActiveWorkbook.Close
End Sub

大题

sheet copy

一个文件里面有多张表，现在想把第一张都保存一个单独的文件，这个应该怎么做呢？

sheets(1).copy

上面这行代码挺有意思，会新打开一个文件，复制sheets(1)这个表格到那个新建的文件当中，那这样的话，这事就好办了。

Sub shishi()
    Dim sht As Worksheet
    For Each sht In Sheets
        sht.Copy
        ActiveWorkbook.SaveAs Filename:="c:data" & sht.Name & ".xlsx"
        ActiveWorkbook.Close
    Next
End Sub

综合大题

现在有一个文件，文件内很多的表，要求如果性别为男，就在称呼那一列判断为男士 ，如果科目是语文，就判断为YW，是数字就都判断为SX。

我们先不写，先想一下应该怎么做这个事情，如果我们仅做一张表的放，就用for+if来做，如下：

Sub shishi()
    Dim i As Integer
    For i = 2 To 100
    ' 判断性别
        If Range("b" & i) = "男" Then
            Range("c" & i) = "男士"
        Else
            Range("c" & i) = "女士"
        End If
    ' 判断科目
        If Range("d" & i) = "语文" Then
            Range("e" & i) = "YW"
        Else
            Range("e" & i) = "SX"
        End If
    Next
End Sub

再加大一点难度，判断如果性别那一列如果有空单元格就将一整行删除。

Sub shishi()
    Dim i As Integer
    For i = 2 To 100
    ' 判断性别
        If Range("b" & i) = "男" Then
            Range("c" & i) = "男士"
        Else
            Range("c" & i) = "女士"
        End If
    ' 判断科目
        If Range("d" & i) = "语文" Then
            Range("e" & i) = "YW"
        Else
            Range("e" & i) = "SX"
        End If
				
			' 判断空单元格
				if range("b" & i) = "" then
				Range("b" & i).Select
        Selection.EntireRow.Delete
        End If
    Next
End Sub

如果有两个连续的空格上面代码就有了问题，我们可以从下向上

Sub shishi()
    Dim i As Integer
		' 从后向前，避免连续的两个空格
    For i = 20 To 2 Step -1
    ' 判断性别
        If Range("b" & i) = "男" Then
            Range("c" & i) = "男士"
        Else
            Range("c" & i) = "女士"
        End If
    ' 判断科目
        If Range("d" & i) = "语文" Then
            Range("e" & i) = "YW"
        Else
            Range("e" & i) = "SX"
        End If
                
            ' 判断空单元格
                If Range("b" & i) = "" Then
                Range("b" & i).Select
        Selection.EntireRow.Delete
        End If
    Next
End Sub

一个表格可以这么做，如果我们有多个文件想同时处理呢？需要我们在外面再套一个循环。

Sub shishi()

    Dim sht As Worksheet
    Dim i As Integer
    
    For Each sht In Sheets
    For i = 20 To 2 Step -1
    ' 判断性别
        If sht.Range("b" & i) = "男" Then
            sht.Range("c" & i) = "男士"
        Else
            sht.Range("c" & i) = "女士"
        End If
    ' 判断科目
        If sht.Range("d" & i) = "语文" Then
            sht.Range("e" & i) = "YW"
        Else
            sht.Range("e" & i) = "SX"
        End If
     ' 判断空单元格，尤其要注意这个地方，先选中表，再选中格，然后再删除
        If sht.Range("b" & i) = "" Then
            sht.Select
            sht.Range("b" & i).Select
            sht.Range("b" & i).EntireRow.Delete
        End If

    Next
	      sht.Copy
        ActiveWorkbook.SaveAs Filename:="c:data" & sht.Name & ".xlsx"
        ActiveWorkbook.Close
    Next
End Sub

再将这些表单独的保存成一个文件，外面再加一个for each。

Sub shishi()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim sht As Worksheet
    Dim i As Integer
    
    For Each sht In Sheets
    For i = 20 To 2 Step -1
    ' 判断性别
        If sht.Range("b" & i) = "男" Then
            sht.Range("c" & i) = "男士"
        Else
            sht.Range("c" & i) = "女士"
        End If
    ' 判断科目
        If sht.Range("d" & i) = "语文" Then
            sht.Range("e" & i) = "YW"
        Else
            sht.Range("e" & i) = "SX"
        End If
     ' 判断空单元格，尤其要注意这个地方，先选中表，再选中格，然后再删除
        If sht.Range("b" & i) = "" Then
            sht.Select
            sht.Range("b" & i).Select
            sht.Range("b" & i).EntireRow.Delete
        End If

    Next
          sht.Copy
        ActiveWorkbook.SaveAs Filename:="c:data" & sht.Name & ".xlsx"
        ActiveWorkbook.Close
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub