大数据EXCEL查询之VBA实现篇《七、值非唯一查询》

本文接3月19日发表的第六篇：EXCEL 大数据查询之六《唯一值查询VBA实现篇》后，继续讲解“值非唯一的查询“的VBA实现方法。请对照阅读。

为了简单明了，就不从头开始讲了，直接从代码讲起，至于前面如何建立宏>>>>Visual Bisic编译器及界面的布局与第六篇的一样，就不再啰嗦了：

直接上代码：

1---5，省略

6 在右侧空白区域输入下面代码（在之前的代码下面添加即可，原先输入的代码不必删除）：如果拷贝代码后不能运行，请对照图片核对，可能有的字符被删除了。

Sub FIND2() '非唯一查询

Dim bcontinue As Boolean

Dim mysearch As Range

Dim myfind As Range

Dim fristmyfind As String

Sheets("CBOM").Select

Sheets("CBOM").Range("b2 : e3000").Select

Selection.ClearContents

i = 2

Do While Cells(i, 1) ""

Cells(i, 1).Select

bcontinue = True

Set mysearch = Sheets("M").Range("A1 : A" & Sheets("M").Range("A1").End(xlDown).Row)

Set myfind = mysearch.Find(what:=Cells(i, 1), LookIn:=xlValues, lookat:=xlWhole)

If Not myfind Is Nothing Then fristmyfind = myfind.Address

Do Until myfind Is Nothing Or Not bcontinue

Cells(i, 2) = Cells(i, 2) & " " & Sheets("M").Cells(myfind.Row, 2)

Cells(i, 3) = Cells(i, 3) & " " & Sheets("M").Cells(myfind.Row, 3)

Cells(i, 4) = Cells(i, 4) & " " & Sheets("M").Cells(myfind.Row, 4)

Set myfind = mysearch.FindNext(myfind)

If myfind.Address = fristmyfind Then bcontinue = False

Loop

Set myfind = Nothing

i = i + 1

Loop

Sheets("CBOM").Select

Set mysearch = Nothing

MsgBox ("OK!")

End Sub

如下图 ：

图1

7 略

8 在COM 页，选中矩形框“A非唯一查询”，点右键>>>指定宏，选”FIND2”即可，

图2

9 –12 略

本文的代码中用到了嵌套的循环结构，首先找到起始的查询点，当再次运行到此时退出。重复的值用空格分开。

第六篇中值唯一查询还是可用的，待全文讲完，你的手里会有一个完整的查询程序。

分享成果，随喜正能量。