识别并提取数据的问题

谢玉红

附件 识别并提取数据附件.rar (84.12 KB, 下载次数: 31)

2023-1-2 16:28 上传

点击文件名下载附件

谢谢老师！

gwjkkkkk

意思看懂了，表二中的示范没看懂？

fzxba

识别并提取数据附件.rar (92.36 KB, 下载次数: 26)

2023-1-2 17:21 上传

点击文件名下载附件

谢玉红

gwjkkkkk 发表于 2023-1-2 17:22
意思看懂了，表二中的示范没看懂？

谢谢老师关注。这个示范，就是结果。

gwjkkkkk

参与一下，请楼主参考。。。

dambcer

感觉整复杂了，仅供参考

zlzz1971

WPS下可执行。

tmplinshi

1. Sub 提取数据()
   
2.     Dim arr(), d As Object, rowIndex, colIndex, k$, rowList, r&
   
3.    
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     arr = Sheet1.UsedRange.Columns("q:r").Value2
   
6.    
   
7.     For rowIndex = 1 To UBound(arr)
   
8.         k = arr(rowIndex, 1) & vbTab & arr(rowIndex, 2)
   
9.         d(k) = d(k) & " " & rowIndex
   
10.     Next
    
11.    
    
12.     Sheet2.Columns("a:r").Clear
    
13.    
    
14.     For Each rowList In d.Items()
    
15.         If Not IsNumeric(Trim(rowList)) Then
    
16.             For Each rowIndex In Split(Trim(rowList))
    
17.                 r = r + 1
    
18.                 Sheet1.Rows(rowIndex).Columns("a:r").Copy Sheet2.Cells(r, 1)
    
19.             Next
    
20.             r = r + 1
    
21.         End If
    
22.     Next
    
23. 
    
24. End Sub

复制代码

wanao2008

其实也可以很简单。

提供代码及视频解答，希望能够帮助到你！

代码如下：

1. Sub byWanao()
   
2.     Dim i&, j&, arr, jsNum&
   
3.     i = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
   
4.     arr = Sheet1.Range("A1:R" & i)
   
5.     For i = 1 To UBound(arr) - 1
   
6.         For j = i + 1 To UBound(arr)
   
7.             If arr(i, 17) = arr(j, 17) And arr(i, 18) = arr(j, 18) Then
   
8.                 jsNum = jsNum + 1
   
9.                 Sheet3.Cells(jsNum, 1).Resize(1, 18) = WorksheetFunction.Index(arr, i)
   
10.                 jsNum = jsNum + 1
    
11.                 Sheet3.Cells(jsNum, 1).Resize(1, 18) = WorksheetFunction.Index(arr, j)
    
12.                 jsNum = jsNum + 1
    
13.             End If
    
14.         Next
    
15.     Next
    
16. End Sub

复制代码

视频讲解地址：
https://www.bilibili.com/video/BV1vv4y1i7So/

nicleyuan

参与一下。哈哈~~~