excel VBA 自学宝典 示例代码2

excel,vba,自学宝典,示例代码,罗刚君编著第二版,自学整理

'案例要求：将文件夹中的文件建立目录，需要包含路径

'知识点：FileDialog

Sub 建立文件目录()

Dim i As Integer, filcut As Integer

With Application.FileDialog(msoFileDialogOpen)

.AllowMultiSelect = True '是否可以多选

.Show '显示对话框

filcut = .SelectedItems.Count '统计用户选择的文件数量

For i = 1 To filcut '遍历所有选择的对象

Cells(i, 1) = .SelectedItems(i)

Next

End With

End Sub

'案例要求：在下午13:30时提示“会议时间到”，并在10分钟之后关闭工作簿 '知识要点：OnTime、Quit

Sub 会议提示()

Application.OnTime TimeValue("13:30:00"), "提示"

Application.OnTime TimeValue("13:40:00"), "关闭工作簿"

End Sub

Sub 提示()

[a1] = "会议时间到，请准时参加！" '单元格产生提示

Range("a1").Font.Size = 30

Columns("a:a").ColumnWidth = 148

Rows("1:1").RowHeight = 70

End Sub

Sub 关闭工作簿()

Application.DisplayAlerts = False

Application.Quit

End Sub

'案例要求：模拟键盘快捷键，打开高级选项

'知识要点：SendKeys

Sub 打开高级选项()

Application.SendKeys "%fi{down 4}"

End Sub

'在A1中输入短句

Sub 在A1输入短句()

[a1].Select

Application.SendKeys "{f2}how are you?{enter}"

End Sub

Sub 向对话框发送字符串()

Dim ans As Integer

Application.SendKeys "12345"

excel,vba,自学宝典,示例代码,罗刚君编著第二版,自学整理

ans = Application.InputBox("请输入验证码", "权限", , , , , , 1)

MsgBox ans

End Sub

'案例要求：利用VBA对VBA过程设置组合键

'知识要点：OnKey

Private Sub 新建工作表()

Sheets.Add

End Sub

Sub 设定组合键()

Application.OnKey "^q", "新建工作表"

End Sub

Sub 恢复()

Application.OnKey "^q", ""

End Sub

Sub 禁止复制与粘贴()

Application.OnKey "^c", "禁止"

Application.OnKey "^v", "禁止"

End Sub

Sub 禁止()

MsgBox "禁止使用本功能", vbOKOnly + vbExclamation

End Sub

Sub 合并A列相同且相邻的单元格2()

Dim rg As Range, rng As Range, rngg As Range

Application.DisplayAlerts = False

Set rg = Application.Intersect(http://www.77cn.com.cnedRange, [a:a])

Set rng = rg(1)

For Each rngg In rg.Offset(1, 0).Resize(rg.Count, 1)

If rngg <> rngg.Offset(-1, 0) Then

Range(rng, rngg.Offset(-1, 0)).Merge

Set rng = rngg

End If

Next

Application.DisplayAlerts = True

rg(1).Select

End Sub

Sub 合并A列相同且相邻的单元格3()

Dim rng As Range, rg As Range, rngs As Range

Application.DisplayAlerts = False '禁止提示

'提取A列与已用数据区域的交集

Set rngs = Application.Intersect(http://www.77cn.com.cnedRange, [a:a])

Set rg = rngs(1) '将交集第一个单元格赋与变量rg

For Each rng In rngs.Offset(1, 0).Resize(rngs.Count, 1) '在交集向下偏移一行的区域中循环

excel,vba,自学宝典,示例代码,罗刚君编著第二版,自学整理

If rng <> rng.Offset(-1, 0) Then '如果对象变量rng与其上一个单元不相等

Range(rg, rng.Offset(-1, 0)).Merge '合并对象变量前面的相同数据区域

Set rg = rng '重新指定对象变量

End If

Next

Application.DisplayAlerts = True '还原提示

rngs(1).Select '选择原选区中第一个单元格

End Sub

Dim rng As String

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = rng Then

If Len(Target) = 0 Or Target = "×" Then

Target = "√"

Else

Target = "×"

End If

End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Application.Intersect(Target, Range("b2:b10")) Is Nothing Then

If Target.Count = 1 Then

rng = Target.Address

If Len(Target) = 0 Or Target = "×" Then

Target = "√"

Else

Target = "×"

End If

End If

End If

End Sub

Sub 选择负数()

Dim rng As Range, rngg As Range

For Each rng In Intersect(http://www.77cn.com.cnedRange, Union([b:b], [e:e]))

If rng.Value < 0 Then

If rngg Is Nothing Then

Set rngg = rng

Else

Set rngg = Union(rng, rngg)

End If

End If

Next rng

rngg.Select

excel,vba,自学宝典,示例代码,罗刚君编著第二版,自学整理

Selection.Interior.ColorIndex = 3

End Sub

Sub 已用区域()

Debug.Print ActiveSheet.Cells(1, 1).CurrentRegion.Address(0, 0)

Debug.Print http://www.77cn.com.cnedRange.Address(0, 0)

Debug.Print Intersect(http://www.77cn.com.cnedRange, Union([b:b], [e:e])).Address(0, 0)

End Sub

Sub 计算累计得分超过1000分()

Dim i As Integer, sums As Integer

i = 1

Do

i = i + 1

sums = Application.WorksheetFunction.Sum(Range("b2").Resize(i, 1))

Loop Until sums >= 1200

MsgBox "第" & i & "场次累计得分超过1200分", vbInformation + vbOKOnly, "提示" End Sub

Sub 计算累计得分超过1000分的场次()

Dim i As Inte …… 此处隐藏：2103字，全部文档内容请下载后查看。喜欢就下载吧 ……