目录

示例：

实现代码：

单元格对象的Clear方法

动态表示数据区域

单元格对象的Copy方法

示例代码2.0

单元格对象的选择性粘贴(PasteSpecial)方法

参数Paste表示选择性粘贴的内容，可以为下表中的任何一个。

参数Operation为粘贴的附加操作，可以为下表中的任何一个。

参数SkipBlanks表示是否跳过空白单元格，若为True，则表示不将剪贴板中的空白单元格复制到目标区域。

参数Transpose表示是否转置，若为True，则表示转置。

示例：

    如图所示，该表为某公司某月销售人员的销售数据。在进行数据核对时，发现某些有问题的数据并将填充色改为灰色。现在需要将这些数据一次性筛选出来并复制到F:H列，该如何利用VBA实现？

实现代码：

Option Explicit

Sub 按颜色查找()
    Dim Rng As Range
    Dim RowN As Long
    
    '清除结果区域
    Range("F2:H" & Rows.Count).Clear
    
    RowN = 1
    For Each Rng In Range(Range("C1"), Cells(Rows.Count, "C").End(xlUp))
        '判断是否有填充色
        If Rng.Interior.Pattern <> xlNone Then
            '复制至结果区域
            Intersect(Rng.EntireRow, Columns("A:C")).Copy Cells(RowN, "F")
            '结果区域行+1
            RowN = RowN + 1
        End If
    Next

End Sub

单元格对象的Clear方法

    本例使用了单元格对象的Clear方法对单元格进行清除操作，该清除操作包括清除所有的数据以及格式。除了Clear方法外，Excel VBA还提供了其他清除单元格的方法，见表。

                                 表 单元格对象(Range)的Clear方法

动态表示数据区域

    本例使用了Range对象的起点与终点表示方式来表示C列的数据区域，起点为C2单元格，而终点则使用End属性获取该列最后一个有数据的单元格。

单元格对象的Copy方法

    单元格对象的Copy方法是将单元格（包括内容、格式、批注等）复制到指定的区域，其语法为：

Rng.Copy [Destination]

    其中，Rng为单元格或单元格区域，参数Destination为目标单元格区域对象。Destination是可以省略的，当省略时，则表示将Rng复制到剪贴板，然后需要用Paste方法进行粘贴。因而本例复制单元格的部分也可以使用以下语句完成：

Intersect(Rng.EntireRow,Columns("A: C")).Copy
Cells (RowN,"F").Select
ActiveSheet.Paste

示例代码2.0

Sub 按颜色查找1()
    Dim Rng As Range
    Dim RowN As Long
    
    '清除结果区域
    Range("F2:H" & Rows.Count).Clear
    
    RowN = 1
    For Each Rng In Range(Range("C1"), Cells(Rows.Count, "C").End(xlUp))
        '判断是否有填充色
        If Rng.Interior.Pattern <> xlNone Then
            '复制至结果区域
            Intersect(Rng.EntireRow, Columns("A:C")).Copy
            Cells(RowN, "F").Select
            ActiveSheet.Paste
            '结果区域行+1
            RowN = RowN + 1
        End If
    Next

End Sub

单元格对象的选择性粘贴(PasteSpecial)方法

    当不需要复制单元格的所有属性时，如只需要复制单元格格式时，可以使用选择性粘贴PasteSpecial方法进行。在使用PasteSpecial方法时，首先需要对源单元格使用Copy方法将单元格复制到剪贴板，然后对目标单元格使用PasteSpecial进行选择性粘贴。PasteSpecial的语法为：

Rng.PasteSpecial [Paste],[Operation],[SkipBlanks],[Transpose]

其中，Rng表示目标单元格区域。

• 参数Paste表示选择性粘贴的内容，可以为下表中的任何一个。

                     表  PasteSpecial方法的Paste参数

• 参数Operation为粘贴的附加操作，可以为下表中的任何一个。

  表 PasteSpecial方法的Operation参数

• 参数SkipBlanks表示是否跳过空白单元格，若为True，则表示不将剪贴板中的空白单元格复制到目标区域。

• 参数Transpose表示是否转置，若为True，则表示转置。

    PasteSpecial方法实质就是工作表的选择性粘贴的基本操作，其参数设置与操作选项的对应关系如图所示。

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

'
'从meta区域查找IP对应的行，包含但不限于应用/模块
'
Function FindServiceByIP(ip As Variant) As Long

    Dim Cell As Range, Rng As Range
    Dim endRow As Long
    endRow = Worksheets("meta").Range("B" & Rows.Count).End(xlUp).Row

    Set Rng = Worksheets("meta").Range("D4:D" & Worksheets("meta").Range("D" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng ' D列 ip列
        With Cell
            If InStr(CStr(.Value2), CStr(ip)) > 0 Then
                FindServiceByIP = Cell.Row
                Exit Function
            End If
        End With
    Next Cell
    FindServiceByIP = 0
End Function


Sub DoSetService()
    On Error Resume Next
    
    Dim IPCell As Range
    Dim endRow As Long
    Dim metaRow As Long
    Dim MoudApp As String
    
    Sheets("访问日志统计").Activate
    endRow = Worksheets("访问日志统计").Range("G" & Rows.Count).End(xlUp).Row
    If endRow < 1 Then Exit Sub

    Application.ScreenUpdating = False
    For Each IPCell In Range("G2:G" & endRow)
        MoudApp = ""
        With IPCell
            metaRow = FindServiceByIP(.Value)
            If metaRow > 0 Then
                MoudApp = Worksheets("meta").Range("B" & metaRow).Value2 & "/" & Worksheets("meta").Range("C" & metaRow).Value2
                Range("I" & IPCell.Row).Value = MoudApp 'I列设置为根据IP查询得到的邮乐资产里的模块/应用
            End If
            '比较邮乐资产的模块应用 与 接口调用时传递的自定义模块应用
            If StrComp(MoudApp, Range("E" & IPCell.Row).Value, 1) <> 0 Then
                Range("J" & IPCell.Row).Value = "×"
            Else
                Range("J" & IPCell.Row).Value = "○"
            End If
            
        End With
    Next IPCell

    Application.ScreenUpdating = True
End Sub

VBA学习笔记7：查找包含某内容的单元格

用途：需要在工作表内包含某内容的单元格找出来

需要将下图中包含9的单元格查找出来：

运行后效果如下：

代码如下：

Sub 通过方法查找()
'区域中查找所有包含9的数字
    Dim rng As Range, rngadress$, sht1 As Worksheet, sht2 As Worksheet
    Worksheets.Add(before:=Worksheets(1)).Name = "含9数据" '创建一个新表存储含9的数据
    [a1] = "含9数据"
    [b1] = "位置"
    Set sht1 = Worksheets(1) '含9数据表
    Set sht2 = Worksheets(2) '原表
    With sht2.UsedRange '在原表所有范围内查找
        Set rng = .Find(9, lookat:=xlPart) '模糊查找
        If rng Is Nothing Then '判断是否找到，如果未找到则说明1个没有，可直接结束（否则进入循环会报错，因为address不存在）
            sht1.[a2] = "无数据"
        Else
            rngadress = rng.Address '确定第一个的位置，为了结束循环使用
            Do
                Set rng = .FindNext(rng)
                sht1.Range("a1045876").End(xlUp).Offset(1, 0) = rng
                sht1.Range("a1048576").End(xlUp).Offset(0, 1) = rng.Address
            Loop Until rngadress = rng.Address
            
        End If
    End With
End Sub

注意：

1、Range(“要查找的区域”).Find
（1）what :=要查找的内容 重要
（2）after:=从哪个位置之后开始查找，如区域为"a1:a11"，after:=a4，则查找顺序a5-a11-a1-a4
（3）lookin:=查找的范围,xlvalues 查找值,xlformulas查找公式，xlcomments查找批注
（4）lookat:=模糊匹配还是精准匹配，xlwhole精确匹配，xlpart模糊匹配
（5）searchorder:=按照行查找还是列查找，xlbyrows 按行，xlbycolumns按列
（6）searchdirection:=查找的方向，xlprevious向前查找，xlnext向后查找
（7）matchcase:=是否区分大小写，true区分
（8）mathchbyte:=是否区分全角半角，true区分
（9）searchformat:=是否带格式查找，true带格式

2、对于第一个要用is nothing判断，否则若为空值，会报错
3、主要语法
with range(…)
set rng=.find(找谁，其他条件)
if rng is nothing then
… 如果没找到的操作
else
set rngaddress=rng.address
do
rng=.findnext(rng)
loop until rng.address=rngaddress '结束循环
end if
end with