1、筛选指定列获取数据

For Each Rng In Sheets("目录").Range("b1:B23")
    Debug.Print Rng.Value
    If Rng.Value = "个人" Then
        n = n + 1
        Sheets("备注").Cells(n, "g").Resize(1, 5) = Rng.Offset(0, -1).Range("a1:e1").Value
        Sheets("备注").Cells(n, "g").Resize(1, 5) = Rng.EntireRow.Range("a1:e1").Value
    End If
Next

2、获取指定杭内容

'On Error Resume Next
Application.ScreenUpdating = False
'MP = ActiveWorkbook.Path
MP = "C:\Users\HONORS\Desktop\（安智）杭实物联网进出库汇总表 总.xlsx" '工作簿路径
'MN = Dir(MP & "\" & "*.xlsx") '工作簿路径
' Set Wb = Workbooks.Open(MP & "\" & MN)
 Set Wb = Workbooks.Open(MP)
 
 For i = 1 To Wb.Sheets.Count
'Cells(i, 1) = Sheets(i).Name
Debug.Print Wb.Sheets(i).Name '获取表名
Next
 
 
 With Wb.Sheets("总账（诸暨库）")
    lr = .Cells(Rows.Count, 1).End(xlUp).Row '获取最后一行
    Set rngs = .Range("A1:A" & lr) '确认列
    For Each Rng In rngs
'        Debug.Print Rng.Value
            If Rng.Value Like "2021/11/24" Then
                n = n + 1
                ThisWorkbook.Sheets("测试").Cells(n, "a").Resize(2, 25) = Rng.EntireRow.Range("a1:y1").Value
                ThisWorkbook.Sheets("测试").Cells(n, "z").Value = ActiveSheet.Name
            End If
    Next
End With

3、调整按模块输出内容:

进出库

Dim k%
'On Error Resume Next
Application.ScreenUpdating = False
'MP = ActiveWorkbook.Path

Name = "（安智）杭实物联网进出库汇总表 总"
Dtransport = "2021/12/17"
MP = "C:\Users\HONORS\Desktop\原始数据\储运数据\" & Name & ".xlsx" '工作簿路径
'MN = Dir(MP & "\" & "*.xlsx") '工作簿路径
' Set Wb = Workbooks.Open(MP & "\" & MN)
 Set Wb = Workbooks.Open(MP)

 
'-----------
' For i = 1 To Wb.Sheets.Count
'    'Cells(i, 1) = Sheets(i).Name
'    Debug.Print Wb.Sheets(i).Name '获取表名
'Next
 '-----------
 last_row_clear = ThisWorkbook.Sheets("进出库").Cells(Rows.Count, 1).End(xlUp).Row '最后一行位置
 Debug.Print "行数" & last_row_clear
 ThisWorkbook.Sheets("进出库").Rows("5:" & last_row_clear).Delete
'-----------
' For i = last_row_clear To 5 Step -1
'ThisWorkbook.Sheets("进出库").Rows(i).Delete
'Debug.Print "删除" & i & "行"
'Next
 '-----------
stockName = Array("总账（镇江库）", "总账（衢州库）", "总账（诸暨库）", "总账（昆山库）", "总账（泉州库）", "总账（武汉库）", "总账（泗阳库）", "总账（全椒库）")
For i = 0 To UBound(stockName)
'Debug.Print i
'        If i = 0 Then
'             Wb.ActiveSheet.Range("a1:Y3").Copy ThisWorkbook.Sheets("测试").Cells(1, 1)  '复制标题
'             ThisWorkbook.Sheets("测试").Cells(1, 1).Resize(3, 1) = 1
'        End If
    With Wb.Sheets(stockName(i))
          Wb.Sheets(stockName(i)).Activate '当前工作表激活
            lr = .Cells(Rows.Count, "A").End(xlUp).Row '获取最后一行
            Set rngs = .Range("A1:A" & lr) '确认列
            For Each Rng In rngs
    '            Debug.Print Rng.Value
                    If Rng.Value Like Dtransport Then
                        k = k + 1 '记录条目
                        Debug.Print "条目" & k & "：" & Rng.Value & ActiveSheet.Name '输出当前工作表内容
                        last_row = ThisWorkbook.Sheets("进出库").Cells(Rows.Count, 1).End(xlUp).Row '最后一行位置
    '                       n = n + 1 '判断行数
                            ThisWorkbook.Sheets("进出库").Cells(last_row, "a").Resize(2, 25) = Rng.EntireRow.Range("a1:y1").Value  '获取对应条目内容
                            ThisWorkbook.Sheets("进出库").Cells(last_row, "z").Value = ActiveSheet.Name  '写入表格名称
                    End If
            Next
        End With
Next
    ThisWorkbook.Sheets("进出库").Range("A:L").RowHeight = 15 '行高
'    ThisWorkbook.Sheets("进出库").Range("C:C").ColumnWidth = 35 '列宽
   Wb.Close False '关闭工作簿

4、获取规定条目内容：

运输

Dim k%
On Error Resume Next
Application.ScreenUpdating = False
'MP = ActiveWorkbook.Path
Name = "脚手架运输台账(热联&安智)12.18"
Dtransport = "2021/12/17"
MP = "C:\Users\HONORS\Desktop\原始数据\储运数据\" & Name & ".xlsx" '工作簿路径
'MN = Dir(MP & "\" & "*.xlsx") '工作簿路径
' Set Wb = Workbooks.Open(MP & "\" & MN)
 Set Wb = Workbooks.Open(MP)
'-----------
' For i = 1 To Wb.Sheets.Count
'    'Cells(i, 1) = Sheets(i).Name
'    Debug.Print Wb.Sheets(i).Name '获取表名
'Next
 '-----------
 
  last_row_clear = ThisWorkbook.Sheets("运输").Cells(Rows.Count, 1).End(xlUp).Row '最后一行位置
 Debug.Print "行数" & last_row_clear
 ThisWorkbook.Sheets("运输").Rows("3:" & last_row_clear).Delete
 
 
stockName = Array("热联")
'For i = 0 To UBound(stockName)
Debug.Print i
'        If i = 0 Then接下来的货量，货量预计；
    With Wb.ActiveSheet 'Wb.Sheets(stockName(0))
'          Wb.Sheets(stockName(0)).Activate '当前工作表激活
            lr = .Cells(Rows.Count, "A").End(xlUp).Row '获取最后一行
            Set rngs = .Range("D1:D" & lr) '确认列
            For Each Rng In rngs
    '            Debug.Print Rng.Value
                    If Rng.Value Like Dtransport Then
                        k = k + 1 '记录条目
                        Debug.Print "条目" & k & "：" & Rng.Value & ActiveSheet.Name '输出当前工作表内容
                        last_row = ThisWorkbook.Sheets("运输").Cells(Rows.Count, 1).End(xlUp).Row '最后一行位置
    '                       n = n + 1 '判断行数
                            ThisWorkbook.Sheets("运输").Cells(last_row, "a").Resize(2, 147) = Rng.EntireRow.Range("a1:EQ1").Value  '获取对应条目内容
                            ThisWorkbook.Sheets("运输").Cells(last_row, "ER").Value = ActiveSheet.Name  '写入表格名称
                    
                    End If
            Next
        End With
         ThisWorkbook.Sheets("运输").Range("A:L").RowHeight = 15 '行高
'         ThisWorkbook.Sheets("运输").Range("C:C").ColumnWidth = 35 '列宽
         
'Next

   Wb.Close False '关闭工作簿

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