普通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:\data\1.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:\data\2.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