第6章修改选区数据_Excel VBA范例大全-QQ阅读男生科幻网

书名：Excel VBA范例大全
作者名：罗刚君编著
本章字数：5017字
更新时间：2020-08-26 20:14:32

第6章修改选区数据

前一章对单元格及区域之格式设置做了详细的实例讲解，本章主要对修改数据如删除、填充、隐藏等操作进行分析。

● 实例41区域数据互换

● 实例42填充空白单元格

● 实例43填充公式

● 实例44批量填充单元格数据

● 实例45删除“不采用”建议字符所在行

● 实例46瞬间删除空白行

● 实例47瞬间删除空白单元格所在行

● 实例48瞬间删除选区空格

● 实例49行列之隐藏与取消

● 实例50符合三个条件则汇总数据

● 实例51汇总行列值

实例41 区域数据互换

【技巧说明】对多个同大小之区域进行数据轮换。

【案例介绍】如图2.24所示，某班清洁工作中将成员分为4组，为了公平，每天让4组成员互换一次，使每个组都能参与到所有的工作中。

图2.24 清洁工作分配表

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub数据轮换()
    Dim myVal(), i As Integer, j As Integer
    On Error Resume Next        '排错
    j=Selection.Areas.Count   '统计选择了多少个单元格区域
    ReDim myVal(1 To j)         '重新定义数组
    With Selection
      For i=1 To j
      '如果各个区域大小不一致，则退出程序
      If .Areas(1).Cells.Count <> .Areas(i).Cells.Count Then Exit Sub
      Next i
      For i=1 To j
        myVal(i)=.Areas(i).Value
      Next i
      .Areas(1)=myVal(j)
      For i=1 To j
        .Areas(i+1)=myVal(i)
      Next i
    End With
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 按住Ctrl键，分别选择4组姓名区域，如图2.25所示，然后用快捷键Alt+F8调出运行宏窗口，单击“执行”按钮。

[6] 程序已将4个区域中的数据交换一次，如图2.26所示。若再运行一次程序，则继续转换区域中的数据。

图2.25 选择4组姓名区域

图2.26 转换一次后的数据

提示

本实例参见光盘样本：..\第2部分\实例41.xlsm。

【相关知识说明】

（1）Areas：由选定区域内的多个子区域或连续单元格块组成的集合。本例中用于统计区域个数。

（2）With…End With：在一个单一对象或一个用户定义类型上执行一系列的语句。主要用于简化代码，同时也加快程序运行。请看以下简化代码前后的区别，两者功能完全一致。

代码一（未使用With语句）：

activecll.Font.Name="宋体"
activecll.Font.FontStyle="加粗 倾斜"
activecll.Font.Size=10
activecll.Font.ThemeColor=xlThemeColorLight2
activecll.Font.TintAndShade=0.4
activecll.Font.ThemeFont=xlThemeFontMinor

代码二（使用With简化代码）：

With activecll.Font
    .Name="宋体"
    .FontStyle="加粗 倾斜"
    .Size=10
    .ThemeColor=xlThemeColorLight2
    .TintAndShade=0.4
    .ThemeFont=xlThemeFontMinor
End With

实例42 填充空白单元格

【技巧说明】批量将选区中空白单元格用上一个非空单元格数据填充。

【案例介绍】如图2.27所示，输入数据时省略了省名，现需要填充所有空白单元格。

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub填充()
Dim rng As Range
  Set rng=Range("A2:A" & Cells(1048576, 2).End(xlUp).Row)
  With rng
    .Select '选择A列数据
    .SpecialCells(xlCellTypeBlanks).Select     '选择空白单元格
    Selection.FormulaR1C1="=R[-1]C"         '输入公式
    rng=.Value                          '将公式转换为值
  End With
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 使用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，区域中的空白单元格即全部填充完毕，如图2.28所示。

图2.27 人口普查简表

图2.28 填充后的普查表

提示

本实例参见光盘样本：..\第2部分\实例42.xlsm。

实例43 填充公式

【技巧说明】填充公式。

【案例介绍】如图2.29所示，产量表分多个组，D3单元格公式需要向下填充，手工下拉将产生多余公式，且无法跳过B组的标题。利用VBA代码则能完善解决此问题。

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub填充公式()
Dim rng As Range, rg As Range
For Each rng In Range("d4:d" & Range("c1048576").End(xlUp).Row)
    Range("d3").Copy
    If rng="" And VBA.IsNumeric(rng.Offset(0,-1)) And rng.Offset
            (0,-1) <> "" Then
      If rg Is Nothing Then
          Set rg=rng
          Set rg=Application.Union(rg, rng)
      End If
    End If
Next
rg.Select
ActiveSheet.Paste
Range("d3").Select
End Sub

Else

[4] 关闭VBE窗口返回到工作表。

[5] 使用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，则D3单元格向下全部填充完毕，如图2.30所示。

图2.29 待填充产量表

图2.30 填充后的产量表

提示

本实例参见光盘样本：..\第2部分\实例43.xlsm。

【相关知识说明】

（1）IsNumeric：返回Boolean值，指出表达式的运算结果是否为数字。本例中用于排除单元格左侧是“制表”之状况，只有左侧是数字时才填充公式。

（2）Copy：复制数据。

（3）Paste：粘贴数据。

实例44 批量填充单元格数据

【技巧说明】批量填充单元格中省略的数据。

【案例介绍】 Excel的选择性粘贴中有加减乘除，但却没有连接功能，即将文本连接到区域中各单元格数据前或者后。如图2.31所示，此段均为四川地区，现需要将每个地区加前缀“四川”。

图2.31 原始数据

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub选择性粘贴_连接()
    Dim a As Byte, b As Range, rng As Range
    If Selection.Count > 1 Or Selection="" Then MsgBox "请选择单个非空
          单元格再执行本程序", 64, "提示": Exit Sub
    a=Application.InputBox("1为链接在前；2为链接在后。", "请输入链接选项",
          "1", 100, 100, Type:=1)
    Set b=Application.InputBox("请输入粘贴区域：","区域","a1",100,100,
          Type:=8)
    For Each rng In b
      If a=1 Then
          rng=Selection.Text & rng.Text
      ElseIf 2=2 Then
          rng=rng.Text & Selection.Text
      End If
    Next
End Sub

[4] 在原区域外添加一个辅助单元格，输入“四川”，并选中该单元格。

[5] 用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，弹出对话框提示输入链接选项，如图2.32所示。

[6] 确定后，弹出对话框提示输入粘贴区域，可以用鼠标选择区域地址，如图2.33所示。

图2.32 输入链接选项

图2.33 输入粘贴区域

[7] 确定后，程序将对选定区域之数据加入前缀，如图2.34所示。

提示

如果选择了空单元格或者选中多个单元格，则无法执行本程序。

图2.34 添加前缀后的数据

提示

本实例参见光盘样本：..\第2部分\实例44.xlsm。

实例45 删除“不采用”建议字符所在行

【技巧说明】删除“不采用”建议字符所在行。

【案例介绍】如图2.35所示，员工建议方案有部分采用，部分未采用。现需清理未采用之方案。

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub清除未采用之方案()
    Dim rng As Range
    For Each rng In Range([c2], Cells(1048576, 3).End(xlUp))
    If rng="不采用" Then     '限定条件
      rng.EntireRow.Delete      '符合条件的都删除整行
    End If
    Next                   '检测下一个
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，程序执行后目标区域中包含“不采用”字样之行全部删除，如图2.36所示。

提示

本实例参见光盘样本：..\第2部分\实例45.xlsm。

图2.35 员工建议表

图2.36 删除“不采用”后的表

实例46 瞬间删除空白行

【技巧说明】瞬间删除无数据之行。

【案例介绍】如图2.37所示，若存在既未入库也无进库的情况，则仓库进出表中整行除日期外均为空白，现为节约打印纸张，需删除所有空白行。

图2.37 仓库进出表

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub清除空白数据行()
    Dim i As Long
    For i=Cells(1048576, 1).End(xlUp).Row To 2 Step-1
    If WorksheetFunction.CountA(Cells(i, 1).EntireRow)=1 Then'限定条件
    Cells(i, 1).EntireRow.Delete      '符合条件的都删除整行
    End If
    Next                   '检测下一个
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，程序执行后目标区域中的空白行全部删除，如图2.38所示。

图2.38 删除空白行后的仓库进出表

提示

本实例参见光盘样本：..\第2部分\实例46.xlsm。

【相关知识说明】

Step：Step用于For…Next时表示循环计数之步长，如果没有指定，则Step的默认值为1。本例中因为是从大到小循环，故参数使用负数。

For…Next的具体语法为（方括号中为可选参数）：

For counter=start To end [Step step]
[statements]
[Exit For]
[statements]
Next [counter]

实例47 瞬间删除空白单元格所在行

【技巧说明】瞬间删除空白单元格所在行。

【案例介绍】本例以例45的另一种状况为例进行演示。如图2.39所示，未采用之建议均为空白，现需删除该列中所有空白单元格所在行的数据。

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub清除空白数据行()
    Dim i As Long
    For i=Cells(1048576, 2).End(xlUp).Row To 3 Step-1
    If Cells(i, 3)="" Then             '如果单元格为空白
    Cells(i, 1).EntireRow.Delete          '符合条件的都删除整行
    End If
    Next                             '检测下一个
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，程序执行后第三列为空白之单元格所在行全部删除，如图2.40所示。

图2.39 带有空白单元格的建入议表

图2.40 删除空白单元格所在行之后的建议表

提示

本实例参见光盘样本：..\第2部分\实例47.xlsm。

实例48 瞬间删除选区空格

【技巧说明】瞬间删除选区数据中输入的空格。

【案例介绍】如图2.41所示，产值表公式引用了的单价参照区域之数据。而产值表的产品名称因输入了空格导致公式结果出错，现需删除已用区域中所有空格，排除公式错误。

图2.41 存在错误的产值表

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub排除空格()
 ActiveSheet.UsedRange.Replace What:=" ", Replacement:="", LookAt:=xlPart
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，程序执行后产值表已用区域中所有空格全部删除，公式结果也已修正。

提示

本实例参见光盘样本：..\第2部分\实例48.xlsm。

实例49 行列之隐藏与取消

【技巧说明】行列之隐藏与取消。

【案例介绍】如图2.42所示，成绩表中有部分人缺考，现查看资料需要将之隐藏。

图2.42 成绩表

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub隐藏与取消()
    MsgBox "现在隐藏第六行", 64, "隐藏"
    Rows(6).Hidden=True
    MsgBox "现在取消所有隐藏", 64, "全部显示"
    Cells.EntireRow.Hidden=False
    MsgBox "现在隐藏第六行和第九行", 64, "隐藏"
    Range("6:6,9:9").EntireRow.Hidden=True
    MsgBox "现在取消所有隐藏", 64, "全部显示"
    Cells.EntireRow.Hidden=False
    MsgBox "现在隐藏第六至第九行", 64, "隐藏"
    Rows("6:9").Hidden=True
    MsgBox "现在取消所有隐藏", 64, "全部显示"
    Cells.EntireRow.Hidden=False
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，程序执行后将连续弹出6次对话框，分别执行6段程序，包括隐藏第六行、取消隐藏（三次）、隐藏第六行和第九行、隐藏第六行至第九行。读者可以每执行一段程序比较一下单元格区域中的变化。

提示

本实例参见光盘样本：..\第2部分\实例49.xlsm。

【相关知识说明】

（1）Rows：返回一个Range对象，代表指定单元格区域中的行，在不使用对象识别符的情况下使用此属性等效于使用ActiveSheet.Rows。

（2）Hidden：返回或设置一个Variant值，指明是否隐藏行或列，将此属性设置为True以隐藏行或列。指定的区域必须占据整个行或整个列。

实例50 符合三个条件则汇总数据

【技巧说明】符合三个条件则汇总数据。

【案例介绍】如图2.43所示，这是一份生产日报表，现需对其汇总。若客户、型体和二次加工项相同，则将数量和金额进行汇总，结果产生在汇总表中。

图2.43 生产日报表

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub汇总()
    Dim i&, tim&, j%
    tim=Hour(Now()) * 3600+Minute(Now()) * 60+Second(Now())
    Application.ScreenUpdating=False          '禁止刷新屏幕
    Sheet2.Cells.Clear                       '清除原数据
    Rows("1:3").Copy Sheet2.Range("a1")         '复制标题
    Sheet2.Columns("d:f").Delete Shift:=xlToLeft
    For i=4 To Range("A1048576").End(xlUp).Row
                          '给变量i赋值，从4到A列最后一个非空行数
    Cells(i, "j")=Cells(i, "b") & Cells(i, "c") & Cells(i, "d")
                          '在j列产生一个辅助列
    Next                                               '重复下一个
    With Sheet2
    For i=4 To Range("A65536").End(xlUp).Row
                          '给变量i赋值，从4到A列最后一个非空行数
      If .Columns("I").Find(Cells(i, "j")) Is Nothing Then
                          '如果汇总表I列不存在辅助列J列之数据
  Range("b" & i & ":e" & i).Copy .Range("A1048576").End(xlUp).
    Offset(1, 0)  '将A列除外的本行数据复制到汇总表
    '对数量和金额进行条件汇总
  .Range("A1048576").End(xlUp).Offset(0, 4)=
        Application.WorksheetFunction.SumIf(Range("j4:j1048576"),
        Cells(i, "j"),Range("H4:H1048576"))
  .Range("A1048576").End(xlUp).Offset(0, 5)=
        Application.WorksheetFunction.SumIf(Range("j4:j1048576"),
        Cells(i, "j"),Range("I4:I1048576"))
  .Range("A1048576").End(xlUp).Offset(0, 6)=Cells(i, "j")
  .Range("A1048576").End(xlUp).Offset(0, 3)=Cells(i, "g")
  End If
Next
.Columns("g").Delete                  '删除辅助列
End With
Columns("j").Delete                   '删除辅助列
MsgBox "运行时间总共" & (Hour(Now()) * 3600+Minute(Now()) * 60+
    Second(Now()))-tim & "秒！", vbOKOnly, "运行完毕"'报告运行时间
Application.ScreenUpdating=True        '禁止刷新屏幕
Call边框
End Sub
Private Sub边框()
Sheet2.Activate
Sheet2.Range("A3:f" & [f1048576].End(xlUp).Row).Select
With Selection.Borders      '边框
.LineStyle=xlContinuous    '线型
.Weight=xlThin           '粗细
End With
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，程序执行后将弹出运行时间对话框。汇总结果如图2.44所示。

图2.44 汇总结果

提示

本实例参见光盘样本：..\第2部分\实例50.xlsm。

【相关知识说明】

（1）Hour(Now()) * 3600+Minute(Now()) * 60+Second(Now())：将当前时间转为秒。程序运行完后再取得一个当前时间，两个时间相减即为程序运行时间。

（2）Cells.Clear：将工作表中的所有数据清除。

（3）Borders：代表Range或Style对象的4个边框。本例中为新生成数据区域加边框。

实例51 汇总行列值

【技巧说明】自动将区域数据按行及按列汇总。

【案例介绍】如图2.45所示，报表需要按行及按列汇总，并且在行标题及列标题处生成“汇总”。

图2.45 待汇总之数据

【案例实现】参见以下步骤：

[1] 使用快捷键Alt+F11进入VBE（Visual Basic Editor）环境。

[2] 单击菜单【插入】\【模块】，打开模块代码窗口。

[3] 在右边代码窗口输入以下代码：

Sub汇总行列值()
    Dim rng1, rng2, r As Integer, c As Integer, i As Integer, j As Integer,
          myArray As Variant, Selectionss  As Range
    Set Selectionss=Application.InputBox("请输入汇总区域(不含标题行)" &
          Chr(10) & "也可以用鼠标选择区域", "定位", , 0, 0, , , 8)
    With Selectionss
      r=.Rows.Count: c=.Columns.Count
      myArray=.Resize(r+1, c+1)
      Application.ScreenUpdating=False
      rng1=.Offset(-1, 0)
      rng2=.Offset(0,-1)
      .Offset(-1, 1)="汇总"
      .Offset(-1, 0)=rng1
      .Offset(1,-1)="汇总"
      .Offset(0,-1)=rng2
      For i=1 To r
          For j=1 To c
              myArray(i, c+1)=myArray(i, c+1)+myArray(i, j)
        myArray(r+1, j)=myArray(r+1, j)+myArray(i, j)
        myArray(r+1, c+1)=myArray(r+1, c+1)+myArray(i, j)
    Next j
  Next i
  .Resize(r+1, c+1)=myArray
End With
Application.ScreenUpdating=True
End Sub

[4] 关闭VBE窗口返回到工作表。

[5] 用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，将弹出选择区域之对话框，选择待汇总之区域（不包括行标题和列标题，只选择数据区域B2∶E10）后程序将自动汇总出行列值，如图2.46所示。

图2.46 汇总后数据

提示

本实例参见光盘样本：..\第2部分\实例51.xlsm。

【相关知识说明】

Resize：调整指定区域的大小。返回Range对象，该对象代表调整后的区域。例如，以下代码表示将A1调整为A1:B2：

range("a1").Resize(2,2)