Excel筛选出相同字符>=4个的单元格

1、在Excel工作表标签“Sheet1”上面单击右键，选择“查看代码”。

2、在VBA编辑器的菜单栏上面点击【插入】、【模块】。

3、在“模块”代码框里面输入以下VBA程序代码，然后按下【F5】键运行程序，或者在VBA编辑器的功能区上面点击“运行”图标运行程序。

Sub MidString()

Dim i1, i2, i3, i4

On Error Resume Next  '忽略运行过程中可能出现的错误

Application.ScreenUpdating = False  '关闭屏幕更新，提高运行速度

Set mysheet1 = ThisWorkbook.Worksheets("Sheet1")  '定义工作表Sheet1

mysheet1.Range("B2:B1000") = ""  '清空B2:B1000的单元格

mysheet1.Range(Cells(1, 200), Cells(100, 200)) = ""  '清空第200列的第1到100的单元格

For i1 = 2 To 1000  '从第2行到1000行

 If mysheet1.Cells(i1, 1) <> "" Then   '如果单元格不为空白，则

  i2 = Len(mysheet1.Cells(i1, 1))   '获取单元格字符长度

  For i3 = 1 To i2   '逐一截取单元格里面的每一个字符

   mysheet1.Cells(i3, 200) = Mid(mysheet1.Cells(i1, 1), i3, 1)

   i4 = Application.WorksheetFunction.CountIf(mysheet1.Range(Cells(1, 200), _

   Cells(100, 200)), mysheet1.Cells(i3, 200))  '统计某一单元格区域里面出现的次数

   If i4 >= 4 Then  '如果出现的次数>=4，则

    mysheet1.Cells(i1, 2) = mysheet1.Cells(i1, 1)  '把第一列单元格填入同一行上面的第二列

    Exit For  '退出For循环

   End If

  Next

 End If

 mysheet1.Range(Cells(1, 200), Cells(100, 200)) = ""

Next

Application.ScreenUpdating = True  '恢复屏幕更新

End Sub

4、回到Excel表格界面，将会在B列看到筛选出来的满足条件的单元格。

5、VBA程序代码解读：

（1）本程序里面借用了工作表Sheet1里面的第200列1~100行作为中介（即：mysheet1.Range(Cells(1, 200), Cells(100, 200))），该单元格区域不应存有数据，否则会造成数据丢失，要么就在程序中改成其他区域的单元格。

（2）A列单元格的字符长度可能不尽相同，因此使用Len函数来获取单元格里面的字符长度，以便后续进一步循环截取、判断。

（3）VBA程序不能直接使用Countif函数，此时需要引用到Excel工作表上面的函数功能（即：Application.WorksheetFunction.CountIf）。

（4）在执行循环判断的过程中，如果满足条件，则退出循环（即：Exit For），以提高程序的运行速度，减少等待时间。