word vba 如何查找出一个字符串中包括了多少个指定子字符串？
 
Sub at()

aaaa = "ASDFSF。ASDF。SDF。234。'XCV。d"

'第1种方法
bbb = Replace(aaaa, "。", "")
cccc = Split(aaaa, "。")
CS1 = Len(aaaa) - Len(bbb)


'第2种方法
CS2 = UBound(Split(aaaa, "。"))

End Sub
 
第1种方法，主要使用了replace函数和len函数。
 
对比替换前后的字符串的长度差值，该差值即是。
 
 
 
第2种方法：
 
使用split函数后，用ubound函数求出得到数组的上标数值。
 
该上标值即是。

 
Vba代码集锦--Find方法(3)-查找所有符合条件的单元格并显示
 
2018-09-14
 
代码示例
 
Sub aaa()
 
"区域查找，从某区域查找所有符合条件的单元格并一一显示
 
Dim MRG As Range, aaa As String
 
Set MRG = Range("A1:F20").Find("A")
 
aaa = MRG.Address
 
Do
 
Set MRG = Range("A1:F20").FindNext(MRG)
 
MsgBox MRG.Address
 
Loop Until MRG.Address = aaa
 
End Sub
 
代码解析
 
‍
 
Sub aaa()
 
Dim MRG As Range, aaa As String
 
"定义MRG为单元格对象，定义aaa为字符类型
 
Set MRG = Range("A1:F20").Find("A"，lookat:=xlpart)
 
"在区域“A1:F20”内寻找包含“A”的单元格，并将其赋值给MRG
 
aaa = MRG.Address
 
"将MRG的地址赋值给aaa
 
Do
 
"开始Do循环
 
Set MRG = Range("A1:F20").FindNext(MRG)
 
"在区域“A1:F20”范围内，从MRG之后开始查找包含“A”的单元格，并将其赋值给MRG
 
"此时MRG的值已经被更新，为区域内第N 1个出现“A”的单元格，N是Do的次数
 
MsgBox MRG.Address
 
"显示MRG的地址，也可以更换为其他需要处理的代码
 
Loop Until MRG.Address = aaa
 
"直到MRG的地址等于aaa(即第一次出现"A"的单元格地址)时停止循环
 
End Sub
 
‍
 
----------------------------------------
 
免责声明：本文仅代表文章作者的个人观点，与本站无关。其原创性、真实性以及文中陈述文字和内容未经本站证实，对本文以及其中全部或者部分内容文字的真实性、完整性和原创性本站不作任何保证或承诺，请读者仅作参考，并自行核实相关内容。
 
http://www.pinlue.com/style/images/nopic.gif

1.EXCEL VBA遍布文件夹的操作
 
关于VBA遍历文件夹主要用的是提供的Application.FileDialo函数来由个人进行自由选择，通过获取选择的文件夹地址之后，通过Dir函数来匹配选取文件夹下的相应的文档。相应的VBA程序代码如下：
 
   Dim sel_Path As String   '//定义一个选择的文件夹
   Dim MyFile As String    '//文件夹中符合条件的文件
  
    '//选取相应的文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        
        .Title = "请选择文件夹"
        
        If .Show = -1 Then
           sel_Path = .SelectedItems(1)       '//所选择的文件夹路径
        Else
            MsgBox "已取消操作！"
            Exit Sub
        End If
        
   End With
   
  Dim sel_PathFullName As String                            '定义一个文件的全路径名称
    
   MyFile = Dir(sel_Path & "\" & "*.csv")
 
2.关于单元格地址的获取
 
在写VBA的过程中，对于单元格地址的获取至关重要，它直接决定了能否完成正确的完成相应的操作。获取单元格地址主要有以下几种方法：
 
2.1          以下几种获取结果如注释所示
 
   F_Max_Range = ActiveCell.Address()           '获得单元格的地址，形式为$A$1
   F_Max_Range = ActiveCell.Address(0, 0)       '获得单元格的地址，形式为A1
   F_Max_Range = ActiveCell.Address(0, 1)       '获得单元格的地址，形式为$A1
   F_Max_Range = ActiveCell.Address(1, 0)       '获得单元格的地址，形式为A$1
   F_Max_Range = ActiveCell.Address(1, 1)       '获得单元格的地址，形式为$A$1
 
         2.2        以变量的形式获取单元格地址
 
以获取最后一列的最后一个单元格的地址为例：首先需要获取获取最后一列的地址，再得到总的行数，将以上两种结果进行拼接，即得出最后一列的最后一个单元格的地址。相应的关键代码如下：
 
Num_Col = Wb.Worksheets(2).UsedRange.Columns.count          '总的列数
Row_Col = Wb.Worksheets(2).UsedRange.Rows.count             '总的行数

Add_Max_Col = Split(Cells(1, Num_Col).Address, "$")(1)      '获得最后一列的地址

Range_Add_Max_Col = Add_Max_Col & "1"                       '最后一列的第一个单元格的地址
Range_Add_Max_Row = Add_Max_Col & Row_Col                   '最后一列的最后一个单元格的地址
 
 2.3           关于单元格的偏移
 
单元格偏移主要用到的函数是Offset，如偏移1个和2个单元格的关键代码：
 
  F_Max_Range = ActiveCell.Offset(0, 1).Address(0, 0)
  S_Max_Range = ActiveCell.Offset(0, 2).Address(0, 0)
 
        2.4            关于选择多个单元格
 
选择多个单元格要注意单元格之间的拼接格式，要注意中间的“：”，如对以上F_Max_Range 到 S_Max_Range单元格的选择的关键代码:
 
Wb.Worksheets(2).Range(F_Max_Range & ":" & S_Max_Range).Select
 
3.关于复制和粘贴
 
复制和粘贴极大的简化了我们的工作，VBA的复制主要通过copy函数来实现，粘贴主要通过Paste来实现。要注意复制和粘贴之前 一定要选中所要复制的列。即select。关键代码：
 
'提取出相应的列到sheet2表中

Dim sel_col As String          '定义需要操作的列
sel_col = Workbooks("遍历文件夹中的csv文件（处理带逗号的VBA程序）").Worksheets(1).Range("B2").Value

sel_col = Mid(sel_col, InStr(sel_col, ":") + 1)

Wb.Worksheets(1).Range(sel_col).Select
Selection.Copy
Wb.Sheets.Add After:=ActiveSheet

Wb.Worksheets(2).Select
ActiveSheet.Paste
 
4 完全代码:
 
本完全代码实现了遍历相应文件夹下的所有EXCEL(CSV)文件，并复制相应的列到另一个sheet中。另外还有分列、绘图操作。关于EXCEL原文件暂不上传，读者可以根据需要进行相应的简单的修改即可。
 
'//遍历文件夹部分，并选中相应的csv文件
    
    Dim sel_Path As String   '//定义一个选择的文件夹
    Dim MyFile As String    '//文件夹中符合条件的文件
    Dim count As Integer   '//一共操作文件的数目
    
    '//选取相应的文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        
        .Title = "请选择文件夹"
        
        If .Show = -1 Then
           sel_Path = .SelectedItems(1)       '//所选择的文件夹路径
        Else
            MsgBox "已取消操作！"
            Exit Sub
        End If
        
   End With
      
   '//创建一个新的文件夹用来保存数据处理的结果
      On Error Resume Next
   Dim Save_Path_Name As String
   Save_Path_Name = sel_Path & "\" & "文件处理结果"
   VBA.MkDir (sel_Path & "\" & "文件处理结果")
  
  Dim sel_PathFullName As String                            '定义一个文件的全路径名称
  Dim Wb As Workbook                                        '定义一个要操作的工作薄
    
    MyFile = Dir(sel_Path & "\" & "*.csv")
    
    '读入文件夹中的第一个.csv文件

   Do While MyFile <> ""
    
    count = count + 1        '记录文件的个数
    
    sel_PathFullName = sel_Path & "\" & MyFile             '相应文件夹下的符合条件的csv文件
        
   'sel_PathFullName = Application.GetOpenFilename            '自定义文件的路径
    Set Wb = Workbooks.Open(sel_PathFullName)                 '打开所选择的文件
   'ActiveWindow.Visible = False                               静默打开并不能读取文件

'提取出相应的列到sheet2表中

Dim sel_col As String          '定义需要操作的列
sel_col = Workbooks("遍历文件夹中的csv文件（处理带逗号的VBA程序）").Worksheets(1).Range("B2").Value

sel_col = Mid(sel_col, InStr(sel_col, ":") + 1)

Wb.Worksheets(1).Range(sel_col).Select
Selection.Copy
Wb.Sheets.Add After:=ActiveSheet

Wb.Worksheets(2).Select
ActiveSheet.Paste

Dim F_Numcol As Long                '第一次复制后数据的列的数目
Dim F_Add_Max_Col As String         '第一次复制后最后一列的地址

F_Numcol = Wb.Worksheets(2).UsedRange.Columns.count
'选中最后一列
Wb.Worksheets(2).Columns(F_Numcol).Select
F_Add_Max_Col = Split(Cells(1, F_Numcol).Address, "$")(1) & "1"       '获得最后一列的地址

'对列进行分列处理
        Selection.TextToColumns Destination:=Range(F_Add_Max_Col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:= _
        "[", TrailingMinusNumbers:=True

Dim Num_Col As Long               '找出表中的最后一列
Dim Row_Col As Long               '找出表中的最后一行
Dim Add_Max_Col As String         '最后一列的地址
Dim Range_Add_Max_Col As String   '定义最后一列的第一个单元格的地址
Dim Range_Add_Max_Row As String   '定义最后一行的第一个单元格的地址

Num_Col = Wb.Worksheets(2).UsedRange.Columns.count          '总的列数
Row_Col = Wb.Worksheets(2).UsedRange.Rows.count             '总的行数

Add_Max_Col = Split(Cells(1, Num_Col).Address, "$")(1)      '获得最后一列的地址

Range_Add_Max_Col = Add_Max_Col & "1"                       '最后一列的第一个单元格的地址
Range_Add_Max_Row = Add_Max_Col & Row_Col                   '最后一列的最后一个单元格的地址

'选中最后一列
Wb.Worksheets(2).Columns(Num_Col).Select

'对分列出的最后一列进行分列，从而删除"]"字符
 Selection.TextToColumns Destination:=Range(Range_Add_Max_Col), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="]", TrailingMinusNumbers:=True
        
 '获得最后一个单元格右边的一个单元格并给其赋值V1
  Wb.Worksheets(2).Range(F_Add_Max_Col).Select
  
    '最后一个单元格右边的一个单元格的地址
  
   Dim F_Max_Range  As String
   Dim S_Max_Range  As String

'   F_Max_Range = ActiveCell.Address()           '获得单元格的地址，形式为$A$1
'   F_Max_Range = ActiveCell.Address(0, 0)       '获得单元格的地址，形式为A1
'   F_Max_Range = ActiveCell.Address(0, 1)       '获得单元格的地址，形式为$A1
'   F_Max_Range = ActiveCell.Address(1, 0)       '获得单元格的地址，形式为A$1
'   F_Max_Range = ActiveCell.Address(1, 1)       '获得单元格的地址，形式为$A$1

   F_Max_Range = ActiveCell.Offset(0, 1).Address(0, 0)
   S_Max_Range = ActiveCell.Offset(0, 2).Address(0, 0)
'   F_Max_Range = Split(ActiveCell.Offset(0, 1).Address, "$")(1) & "1"
'   S_Max_Range = Split(ActiveCell.Offset(0, 2).Address, "$")(1) & "1"
   
  ActiveCell.Offset(0, 1).Value = "V1"
  ActiveCell.Offset(0, 2).Value = "V2"
  
   '给分列之后的数据定义一个标签
  Wb.Worksheets(2).Range(F_Max_Range & ":" & S_Max_Range).Select
    Selection.AutoFill Destination:=Wb.Worksheets(2).Range(F_Max_Range & ":" & Range_Add_Max_Col), Type:=xlFillDefault  

'按时间排序
   Wb.Worksheets(2).Sort.SortFields.Clear
   Wb.Worksheets(2).Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Wb.Worksheets(2).Sort
        .SetRange Range("A2:" & Range_Add_Max_Row)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    '添加图表：选中数据源
    Wb.Worksheets(2).Range(F_Max_Range).Select
    Wb.Worksheets(2).Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    
    '更改图片的大小
    ActiveSheet.Shapes(1).ScaleWidth 1.6, msoFalse, _
        msoScaleFromBottomRight

    ActiveSheet.Shapes(1).ScaleHeight 1.8, msoFalse, _
        msoScaleFromBottomRight
           
  Wb.Worksheets(2).Range("A1").Select
  
'将文件另存为Excel文件
Dim L As Long
Dim Exc_str As String
L = Len(MyFile) - 3
Exc_str = Save_Path_Name & "\" & Mid(MyFile, 1, L) + "xlsx"

Dim FS As Object
Set FS = CreateObject("Scripting.FileSystemObject")
'//判断文件是否存在
  If FS.FileExists(Exc_str) Then
  
     Ans = MsgBox(Mid(MyFile, 1, L) + "xlsx" & "文件已经存在,是否覆盖现有文件", vbYesNo)
     
      If Ans = vbYes Then
      
       Kill Exc_str      '//删除存在的文件
           
        ActiveWorkbook.SaveAs Filename:=Exc_str, FileFormat:= _
         xlOpenXMLWorkbook, CreateBackup:=False

      End If
      
 Else
 
      ActiveWorkbook.SaveAs Filename:=Exc_str, FileFormat:= _
         xlOpenXMLWorkbook, CreateBackup:=False
         
 End If

 Wb.Close SaveChanges:=False    '关闭文件
 
  '第二次读入的时候不用写参数
        MyFile = Dir
        If MyFile = "" Then
            MsgBox "一共操作了" & count & " 个csv文件！"
            Exit Do         '当MyFile为空的时候就说明已经遍历完了，这时退出Do，否则还要运行一遍
        End If

    Loop
 
遇见不易，欢迎留言评论，共同学习，共同进步，让工作变得更轻松。

1 模糊查找，用通配符 * 代表其他任意字符
 
SUMIF(报价全页!B:B,"*"&A3&"*",报价全页!H:H)
COUNTIF(C:C,"*"&F3&"*")
 
2 下面是具体例子
 
EXCEL，如何在多个单元格内查询是否有某个字符
find() 等函数，只能查找一个单元格内是否有某个字符
而需要用
countif() 配合 通配符 *
比如 查找 A 就写成 "*A*" ，或者 "*"&F3&"*"
但是不能区分大小写
下图公式，比如 =COUNTIF(C:C,"*"&F3&"*")