在Sheet1中准确查找出Sheet2 B列28行-45行相同数据

510929767

请求宏代码的高手帮忙，我还是个菜鸟，在百度查找了好多例子，都看不懂，查找数据的代码不会写，麻烦哪位高手帮忙写一下，谢谢！

想要达到的目的就是我附件上传的数据为例。根据Sheet2  B列28行-45行的数据。

在Sheet1的28行-45行所有数据中准确查找出相同数据，并将相同数据选择出来。

如果有办法最好用Sheet2，B列28行以下数据，在Sheet1的所有的28行以下数据进行准确查找出来，并将相同数据选择出来。

代码编写在Sheet2在查询按钮中

谢谢！

金樽空对月

510929767 发表于 2020-4-11 16:07
谢谢你的帮助，我要查找出来的效果就是第二张图我用绿色框圈出来的位置，找到后选择。在Sheet1中找到和Shee ...

1. Sub mysel()
   
2. Dim x, y, z, n As Long
   
3. Dim ar, br, cr
   
4. Dim rg As Range
   
5. Dim str, st As String
   
6. cr = Sheet2.Range("b28:b45")
   
7. str = Join(Application.WorksheetFunction.Transpose(cr), "-")
   
8. Sheet1.Activate
   
9. z = Sheet1.UsedRange.Columns.Count
   
10. ar = Sheet1.Range(Cells(28, 1), Cells(45, z))
    
11. For x = 1 To UBound(ar, 2)
    
12.    br = Application.WorksheetFunction.Index(ar, 0, x)
    
13.    st = Join(Application.WorksheetFunction.Transpose(br), "-")
    
14.    If st = str Then
    
15.      n = n + 1
    
16.      If n = 1 Then Set rg = Sheet1.Range(Cells(28, x), Cells(45, x))
    
17.      Set rg = Union(rg, Sheet1.Range(Cells(28, x), Cells(45, x)))
    
18.    End If
    
19. Next
    
20. If n = 0 Then MsgBox "未发现相同数据！": Exit Sub
    
21. rg.Select
    
22. End Sub

复制代码

金樽空对月

你这个查找出来是什么意思，能不能举例说明，查找出来后是个什么效果

510929767

谢谢你的帮助，我要查找出来的效果就是第二张图我用绿色框圈出来的位置，找到后选择。在Sheet1中找到和Sheet2  B列28行-45行相同的数据，Sheet1的28行-45行相同的数据选择出来就可以，相同项一定要在同一列

shuidisyy

1. Dim i As Integer, irow As Integer, arr, ss As String, icol As Integer, temparr, str As String
   
2.     With Sheet1
   
3.         irow = .Range("a28").CurrentRegion.Rows.Count
   
4.         icol = .Range("a28").CurrentRegion.Columns.Count
   
5.         arr = Range(.Cells(28, 1), .Cells(irow, icol)).Value
   
6.         str = Join(Application.WorksheetFunction.Transpose(Sheet2.Range("b28:b" & irow).Value), "-")
   
7.     End With
   
8.     For i = 1 To UBound(arr, 2)
   
9.         temparr = Application.WorksheetFunction.Index(arr, 0, i)
   
10.         ss = Join(Application.WorksheetFunction.Transpose(temparr), "-")
    
11.         If str = ss Then Exit For
    
12.     Next i
    
13.     If i <> UBound(arr, 2) + 1 Then
    
14.         Sheet1.Activate
    
15.         Range(Cells(28, i), Cells(irow, i)).Select
    
16.     Else
    
17.         MsgBox "没找到"
    
18.     End If

复制代码

510929767

谢谢你，帮了我大忙了，我自己弄了半个月都没有弄好

金樽空对月

510929767 发表于 2020-4-11 20:40
谢谢你，帮了我大忙了，我自己弄了半个月都没有弄好

4楼大哥的貌似只能查找出一列相同数据，如果有两列也只能选一列

510929767

谢谢你们的帮忙，之前是我考虑不周，想的不够。我之前想着能找到完全一模一样就可以，然后我把找到的相同数据那列给删除掉，试着再查找，就没法了。看截图，能不能改成判断到最后两个（或者判断到后面数据），他们之间如果相差1的话也可以进行选择。就算不相同也能把前面几个相同的数据选择，不要提示没有发现数据。麻烦了

510929767

      我是想通过判断Sheet2  B列28行-45行的数据，在找到工作表中的28行-45行中是否有相同项，或者有想类似的，在相类似数据选择后，把Sheet2B列的B1:B75复制的数据，在他旁边插入复制的单元格。

     上传的附件中找的相同数据是我自己手动查找再插入的，我的数据太多了，要花很多时间。

因为每一次判断的Sheet2  B列28行-45行的数据都是完全不一样的。之前我自己做的时候查找的工作簿名称是根据B列28行橙色背景色数据命名，
我重新上传附件，帮我再分析一下，我的文件太大了上传不了。我只上传大约需要的内容，在附件中已备注好需要的要求，麻烦各位大神了