# Exit 语句应用方案

## 知识概述

Exit 语句用来退出 Do...Loop、For...Next、Function、Sub 或 Property 代码块。Exit 语句包括了以下几种类型：

Exit Do

Exit For

Exit Function

Exit Property

Exit Sub

Exit 语句中各类型的作用如表 1 所示。

表 1 Exit 语句中各类型的作用

语句类型 | 作　　用
Exit Do | 退出 Do...Loop 循环的一种方法，只能在 Do...Loop 循环语句中使用。Exit Do 语句会将控制权转移到 Loop 语句之后的语句。当 Exit Do 语句用在嵌套的 Do...Loop 循环语句中时，Exit Do 语句会将控制权转移到 Exit Do 语名所在位置的外层循环
Exit For | 退出 For…Next 循环的一种的方法，只能在 For...Next 或 For Each...Next 循环中使用。Exit For 语句会将控制权转移到 Next 语句之后的语句。当 Exit For 语句用在嵌套的 For...Next 或 For Each...Next 循环中时，Exit For 语句将控制权转移到 Exit For 语句所在位置的外层循环
Exit Function | 立即从包含该语句的 Function 过程中退出。程序会从调用 Function 过程的语句之后的语句继续执行
Exit Property | 立即从包含该语句的 Property 过程中退出。程序会从调用 Property 过程的语句之后的语句继续执行
Exit Sub | 立即从包含该语句的 Sub 过程中退出。程序会从调用 Sub 过程语句之后的语句继续执行

例如在 For…Next 循环语句中，当满足某种条件时退出循环，就可以通过使用 Exit For 语句实现，程序代码如下：

Dim I As Long

For I = 1 To 100

If I = 50 Then Exit For '当 I=50 时退出循环

Next I

Debug.Print I 'I 的值为 50

## 应用一：退出 Do...Loop 语句

本示例示范如何使用后测型 Do…Loop 语句。如果 Do…Loop 语句循环到第 10 次时，提示用户，并用 Exit Do 语句强制退出循环。完整代码如下。

Dim i As Integer

i = 0

Do

i = i + 1

If i = 10 Then

MsgBox "循环结束！", , "测试循环"

Exit Do

End If

Loop While i < 10

本范例将使用 Do Loop 循环语句实现在 ListView 控件中显示客房信息的功能，结果如图 3 所示。

图 3 在 ListView 控件中显示数据

完整程序代码如下：

Private Sub Form_Load()

Dim cnn As New ADODB.Connection

Dim rs As New ADODB.Recordset

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_kfgl.mdb;"

ListView1.View = lvwIcon

ListView1.ListItems.Clear

rs.Open "select 房间号 as 房号,房态 as 房间状态 from kf group by 房态,房间号 order by 房态", cnn, adOpenKeyset, adLockOptimistic

If rs.RecordCount > 0 Then

zs = rs.RecordCount

rs.MoveFirst

Do While rs.EOF = False

Select Case rs.Fields("房间状态")

Case "空闲房"

ListView1.ListItems.Add , , rs.Fields("房号") & "(" & rs.Fields("房间状态") & ")", 1

Case "打扫中"

ListView1.ListItems.Add , , rs.Fields("房号") & "(" & rs.Fields("房间状态") & ")", 2

Case "入住房"

ListView1.ListItems.Add , , rs.Fields("房号") & "(" & rs.Fields("房间状态") & ")", 3

rz = rz + 1

Case "维修中"

ListView1.ListItems.Add , , rs.Fields("房号") & "(" & rs.Fields("房间状态") & ")", 4

End Select

rs.MoveNext

Loop

End If

rs.Close

End Sub

## 应用二：自定义延时函数

创建自定义函数，在该自定义函数中存在一个无限循环，当前时间等于函数刚被调用的时间加上延时时，使用 Exit Do 语句跳出无限循环。在无限循环中需要使用 DoEvents 函数，否则电脑会死机。

最终效果如图所示。

程序代码如下：

★★★★★ Form1 ★★★★★★

Private Sub Command1_Click()

sleep (Val(Text1))

MsgBox "hello"

End Sub

Private Function sleep(ByVal canshu As Integer)

Dim oldtime As Date

oldtime = Now

Do While 1 = 1

If DateAdd("s", canshu \ 1000, oldtime) = Now Then

Exit Do

End If

DoEvents

Loop

End Function

## 应用三：退出 For...Next 语句

在打印文件的过程中，经常会遇到因打印内容超长，而造成打印内容不全。本实例将实现打印的超长文本自动换行。运行程序，如图所示，在文本框中输入数据，单击“打印”即可打印文本框中的数据，如果文本超过纸宽，打印内容将自动换行。

最终效果如图所示。

图 打印界面

图 打印效果

程序代码如下：

★★★★★ Form1 ★★★★★★

Dim mystr, str1, str2 As String

Dim len1 As Long

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

Private Sub Command1_Click()

len1 = Int(Printer.ScaleWidth / Printer.TextWidth("宽"))

'其中 len1 为打印的字符数， Str1 为打印的文本。

mystr = Text1

Do While Len(mystr) > 0

str1 = Left(mystr, len1)

For i = 1 To 2 * len1

If lstrlen(str1) >= len1 * 2 Then

Exit For

Else

str1 = Left(mystr, len1 + i)

End If

Next i

Printer.Print str1

If (Len(mystr) - len1) < 0 Then

Exit Do

Else

str2 = Right(mystr, Len(mystr) - Len(str1))

End If

mystr = str2

Loop

Printer.EndDoc

End Sub

Private Sub Command2_Click()

End

End Sub

## 应用四：哥德巴赫猜想

哥德巴赫猜想即任意一个大于 6 的偶数，都可以写成两个素数的和。

最终效果如图所示。

程序代码如下：

★★★★★ Form1 ★★★★★★

Option Explicit

Private Sub Command1_Click()

Dim a As Long, b As Long, c As Long, e As Long, g As Long

Dim d As Boolean

If IsNumeric(Text1.Text) Then a = CLng(Text1.Text)

If a Mod 2 = 0 And a >= 6 Then

For b = 2 To a

d = False

For c = b - 1 To 2 Step -1

If b Mod c = 0 Then

Exit For

Else

e = a - b

For g = e - 1 To 2 Step -1

If e Mod g = 0 Then

d = False

Exit For

End If

d = True

Next g

End If

If d = True Then Exit For

Next c

If d = True Then

Label2.Caption = "结果：符合！" & a & "=" & e & "+" & b

Exit For

Else

Label2.Caption = "结果：不符合"

End If

Next b

End If

End Sub

## 应用五：退出 Function

本实例将定义一个用于获取汉字拼音简码的函数。该函数返回汉字的拼音简码，其值为字符型。参数 mystr 为要获取拼音简码的汉字。完整函数代码如下。

Public Function py(mystr As String) As String

If Asc(mystr) < 0 Then

If Asc(Left(mystr, 1)) < Asc("啊") Then

py = "0"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("啊") And Asc(Left(mystr, 1)) < Asc("芭") Then

py = "A"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("芭") And Asc(Left(mystr, 1)) < Asc("擦") Then

py = "B"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("擦") And Asc(Left(mystr, 1)) < Asc("搭") Then

py = "C"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("搭") And Asc(Left(mystr, 1)) < Asc("蛾") Then

py = "D"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("蛾") And Asc(Left(mystr, 1)) < Asc("发") Then

py = "E"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("发") And Asc(Left(mystr, 1)) < Asc("噶") Then

py = "F"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("噶") And Asc(Left(mystr, 1)) < Asc("哈") Then

py = "G"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("哈") And Asc(Left(mystr, 1)) < Asc("击") Then

py = "H"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("击") And Asc(Left(mystr, 1)) < Asc("喀") Then

py = "J"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("喀") And Asc(Left(mystr, 1)) < Asc("垃") Then

py = "K"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("垃") And Asc(Left(mystr, 1)) < Asc("妈") Then

py = "L"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("妈") And Asc(Left(mystr, 1)) < Asc("拿") Then

py = "M"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("拿") And Asc(Left(mystr, 1)) < Asc("哦") Then

py = "N"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("哦") And Asc(Left(mystr, 1)) < Asc("啪") Then

py = "O"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("啪") And Asc(Left(mystr, 1)) < Asc("期") Then

py = "P"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("期") And Asc(Left(mystr, 1)) < Asc("然") Then

py = "Q"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("然") And Asc(Left(mystr, 1)) < Asc("撒") Then

py = "R"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("撒") And Asc(Left(mystr, 1)) < Asc("塌") Then

py = "S"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("塌") And Asc(Left(mystr, 1)) < Asc("挖") Then

py = "T"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("挖") And Asc(Left(mystr, 1)) < Asc("昔") Then

py = "W"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("昔") And Asc(Left(mystr, 1)) < Asc("压") Then

py = "X"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("压") And Asc(Left(mystr, 1)) < Asc("匝") Then

py = "Y"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("匝") Then

py = "Z"

Exit Function

End If

Else

If UCase(mystr) <= "Z" And UCase(mystr) >= "A" Then

py = UCase(Left(mystr, 1))

Else

py = mystr

End If

End If

End Function

Private Sub Text1_Change()

If Option1.Value = True Then

Command1_Click

End If

End Sub

Private Sub Command1_Click()

Dim a As Integer

Label1.Caption = ""

a = Len(Text1.Text)

For i = 1 To a

Label1.Caption = Label1.Caption & py(Mid(Text1.Text, i, 1))

Next i

End Sub

Private Sub Command2_Click()

End

End Sub

下面将使用 py 函数来获得汉字的拼音简码。运行程序，在文本框中输入汉字，单击【显示字母】按钮，即可显示输入汉字的拼音简码，结果如图 2 所示。如果需要自动获得汉字的拼音简码，可以选择“自动获得字母”单选按钮。

图 2 使用 py 函数获得汉字的拼音简码

程序代码如下。

Private Sub Text1_Change()

If Option1.Value = True Then

Command1_Click

End If

End Sub

Private Sub Command1_Click()

Dim a As Integer

Label1.Caption = ""

a = Len(Text1.Text)

For i = 1 To a

Label1.Caption = Label1.Caption & py(Mid(Text1.Text, i, 1))

Next i

End Sub

## 应用六：查找指定报文文件

在大型的实践工程当中，经常会用到查找文件的功能。如在军事文件管理系统当中，经常需要查找报文文件或其他文本文件，如图 1 查找报文文件界面中，选择响应的文件夹并且输入要查找的文件类型后，单击“查找”按钮，在 ListBox 控件中就可以显示查找到的所有结果。

图 1 查找报文文件

程序完整代码如下：

Private Sub Command2_Click()

frm_copy.Show

End Sub

Private Sub Command3_Click()

End

End Sub

Private Sub Command1_Click()

If Text1.Text = "" Then

MsgBox "输入不能为空值"

Else

MousePointer = vbHourglass

DoEvents

List1.Clear

Label1.Caption = "正在查找......"

Autosearchfiles Dir1.Path, Text1.Text, List1

MousePointer = vbDefault

End If

Label1.Caption = "当前查找到的文件总数为：" & List1.ListCount & "个"

End Sub

Private Sub Drive1_Change()

On Error Resume Next '错误处理语句

Dir1.Path = Drive1.Drive

End Sub

Private Sub Form_Load()

Me.Left = (Screen.Width - Me.Width) / 2

Me.Top = (Screen.Height - Me.Height) / 2

Drive1.Drive = "c:\"

Dir1.Path = "c:\"

End Sub

'查找文件的过程函数

Public Function Autosearchfiles(ByVal sDirName As String, ByVal FileFilter As String, lstFilesFound As ListBox) As Boolean

On Error GoTo RF_ERROR

Dim sName, sFile, sExt As String

Dim sDirlist() As String, iDirNum As String, i As Integer

'首先找出该目录下的所有文件

sFile = Dir(sDirName + FileFilter, vbNormal Or vbArchive Or vbHidden)

Do While Len(sFile) > 0

sFile = UCase(Trim(sFile))

'将 sFile 加入到 List 控件当中

lstFilesFound.AddItem sDirName & sFile

List1.Refresh

sFile = Dir

Loop

'准备遍历全部子目录

iDirNum = 0

sName = Dir(sDirName + "*.*", vbDirectory Or vbNormal)

Do While Len(sName) > 0

If sName <> "." And sName <> ".." Then

iDirNum = iDirNum + 1

ReDim Preserve sDirlist(1 To iDirNum)

sDirlist(iDirNum) = sDirName + sName + "\"

End If

sName = Dir

Loop

For i = 1 To iDirNum

List1.Refresh

Autosearchfiles sDirlist(i), FileFilter, lstFilesFound

Next

RF_EXIT:

Autosearchfiles = True

Exit Function

RF_ERROR:

Resume RF_EXIT

End Function

## 应用七：退出 Sub 过程

利用 Exit Sub 语句可以提前结束 Sub 过程而不执行 Exit Sub 下面的程序代码。利用 FileCopy 函数可以在本机磁盘上复制文件，也可以将磁盘中的文件复制到网络中任意一台计算机的磁盘中，该函数主要应用在复制文件方面，如图 1 所示。

图 1 利用 FileCopy 函数复制文件

完整程序代码如下：

Private Sub Command1_Click()

CommonDialog1.Filter = "文本文件(*.doc)|*.doc|Txt 文件(*.Txt)|*.txt|ALL File(*.*)|*.*"

CommonDialog1.ShowOpen

Text1.Text = CommonDialog1.FileName

End Sub

Private Sub Command2_Click()

CommonDialog1.Filter = "文本文件(*.doc)|*.doc|Txt 文件(*.Txt)|*.txt|ALL File(*.*)|*.*"

CommonDialog1.ShowSave

Text2.Text = CommonDialog1.FileName

If Text1.Text = "" Then

Exit Sub

Else

Command3.Enabled = True

End If

End Sub

Private Sub Command3_Click()

Dim char As Byte

FileCopy Text1.Text, Text2.Text '利用 FileCopy 函数复制文件

MsgBox "文件复制完成!!", , "提示信息"

Command3.Caption = "开始复制"

End Sub

Private Sub Command4_Click()

Unload Me

End Sub

Private Sub Form_Load()

Me.Left = (Screen.Width - Me.Width) / 2

Me.Top = (Screen.Height - Me.Height) / 2

End Sub

## 应用八：限制数据的输入范围

### 实例说明

如果用户手工输入年、季和月等数据，则很容易出现数据输入错误。例如，将月份输成 15。这时就要求在设计程序时限制用户输入数据的范围，以防止将错误的数据保存到数据表中。运行程序，在“统计方式”下拉列表框中选择“按月”，在其旁边的文本框中输入相应的月份，如果不小心输入了错误的数据，系统将提示用户，结果如图 1 所示。

图 1 限制数据的输入范围

### 思路与技术

Exit 语句的形式有很多。一般用在循环结构中，如 Exit Do 用来中途退出循环结构。另外，Exit 语句还可以用在过程或者函数中，如 Exit Sub 和 Exit Function 等。

Exit Sub 语句可以直接退出子过程。Exit Sub 可以出现在子过程主体内的任何地方，出现的次数根据需要而定。

当过程已经完成每个任务并可直接返回时，Exit Sub 是非常有用的。

### 开发步骤

（1）新建一个标准工程，创建一个新窗体，设置其“名称”属性为 main_xstj。

（2）在 main_xstj 窗体上添加两个 Label 控件、两个 TextBox 控件和一个 ComboBox 控件。

（3）在 main_xstj 窗体上添加一个 ADO 控件和一个 MSHFlexGrid 控件。这两个控件都属于 ActiveX 控件，在使用前应先将其添加到工具箱中，具体添加方法如下：

选择 VB 菜单的“工程”→“部件”，然后选取 Microsoft ADO Data Control 6.0（SP4）（OLEDB）和 Microsoft Hierarchical FlexGrid Control 6.0（SP4）（OLEDB），单击“确定”按钮。此时，ADO 控件和 MSHFlexGrid 控件出现在工具箱中。

表 1 main_xstj 窗体中控件部分属性设置

控件名 | 属性 | 值
Adodc | Name ConnectionString CommandType RecordSource Visible | Adodc1 Provider=Microsoft.Jet.OLEDB.4.0;Data Source=db_sell.mdb;Persist Security Info=False 1-adCmdText select*from 出货从表 False
CommandButton | Name Caption | cmdExit 退出
CommandButton | Name Caption | cmdFind 统计
ComboBox | Name | Combo1
Label | Name Caption | Label1 统计年份
Label | Name Caption | Label2 统计方式
MSHFlexGrid | Name BackColorFixed | MSHFlexGrid1 &H00FFC0C0&
TextBox | Name | txtdata
TextBox | Name | txtYear

（4）为 main_xstj 窗体添加如下代码。

Private Sub Form_Load()

Combo1.AddItem "按月"

Combo1.AddItem "按季"

Combo1.ListIndex = 0

txtYear = Year(Date)

txtdata = Month(Date)

cmdFind_Click

End Sub

Private Sub txtdata_GotFocus()

txtdata.SelStart = 0

txtdata.SelLength = Len(txtdata)

End Sub

Private Sub txtYear_GotFocus()

txtYear.SelStart = 0

txtYear.SelLength = Len(txtYear)

End Sub

Private Sub txtYear_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyReturn Then txtdata.SetFocus

End Sub

Private Sub cmdFind_Click() '查询统计

Dim r1 As Integer, sql As String

If IsNumeric(txtYear) = False Then

MsgBox "请输入正确的年份！", , "提示窗口"

txtYear.SetFocus

Exit Sub

End If

If txtYear < 0 Then

MsgBox "年份不能小于 0！", , "提示窗口"

txtYear.SetFocus

Exit Sub

End If

If IsNumeric(txtdata) = False Then

MsgBox "请输入正确的" & Right(Combo1, 1), , "提示窗口"

txtdata.SetFocus

Exit Sub

End If

If Combo1.Text = "按月" Then

If txtdata > 12 < 0 Then

MsgBox "月份不能大于 12 或小于 0！", , "提示窗口"

txtdata.SetFocus

Exit Sub

End If

Adodc1.RecordSource = "select 商品名称,规格,单位,sum(出货数量) as 出货总数,sum(金额) as 出货总金额 from 出货从表 INNER JOIN 出货主表 on 出货从表.出货票号=出货主表.票号" _

& " where year(出货主表.出货日期)='" + txtYear + "' and month(出货主表.出货日期)='" + txtdata + "'group by 商品名称,规格,单位"

Adodc1.Refresh

Else

If txtdata > 4 < 0 Then

MsgBox "季度不能大于 4 或小于 0！", , "提示窗口"

txtdata.SetFocus

Exit Sub

End If

Select Case txtdata.Text

Case 1

sql = "month(出货主表.出货日期)=1 or month(出货主表.出货日期)=2 or month(出货主表.出货日期)=3"

Case 2

sql = "month(出货主表.出货日期)=4 or month(出货主表.出货日期)=5 or month(出货主表.出货日期)=6"

Case 3

sql = "month(出货主表.出货日期)=7 or month(出货主表.出货日期)=8 or month(出货主表.出货日期)=9"

Case 4

sql = "month(出货主表.出货日期)=10 or month(出货主表.出货日期)=11 or month(出货主表.出货日期)=12"

End Select

Adodc1.RecordSource = "select 商品名称,规格,单位,sum(出货数量) as 出货总数,sum(金额) as 出货总金额 from 出货从表 inner join 出货主表 on 出货从表.出货票号=出货主表.票号" _

& " where year(出货主表.出货日期)='" + txtYear + "' and " & sql & " group by 商品名称,规格,单位"

Adodc1.Refresh

End If

r1 = Adodc1.Recordset.RecordCount

With MSHFlexGrid1

Set .DataSource = Adodc1

For i = 1 To r1

.TextMatrix(i, 5) = Format(.TextMatrix(i, 5), "##,##0.00")

Next i

.ColWidth(0) = 200

.ColWidth(1) = 3800

.ColWidth(2) = 2000

.ColWidth(3) = 1200

.ColWidth(4) = 1900

.ColWidth(5) = 1900

End With

End Sub

Private Sub cmdExit_Click()

End

End Sub