想把多个表内的第1名，用vba提取出来，求大师帮忙

eutu

想把多个表内的第1名，用vba提取出来，求大师帮忙

工作簿1.rar (7.92 KB, 下载次数: 16)

2020-12-4 21:02 上传

点击文件名下载附件

cjc209

供参考
Sub 过程()
    brr = Array([a1], [g1])
    For Each Rng In brr
        arr = Rng.CurrentRegion
        For r = 2 To UBound(arr)
            If arr(r, 3) = 1 Then
                [a22].Offset(k, 0).Resize(1, 3) = Application.Index(arr, r, 0)
                k = k + 1
            End If
        Next r
    Next
End Sub

wxxydl

Public k, brr(1 To 100, 1 To 3)
Sub main()
    Dim arr1, arr2
    arr1 = Worksheets("sheet1").Range("a1").CurrentRegion
    取第一名 (arr1)
    arr2 = Worksheets("sheet1").Range("g1").CurrentRegion
    取第一名 (arr2)
    Worksheets("sheet2").Range("a1").Resize(k, UBound(arr2, 2)) = brr
End Sub
Function 取第一名(arr)
    Dim i, j
    For i = 2 To UBound(arr)
        If arr(i, 3) = 1 Then
            k = k + 1
            For j = 1 To UBound(arr, 2)
               brr(k, j) = arr(i, j)
            Next
        End If
    Next
    取第一名 = brr
End Function

cui26896

请参考附件
工作簿1.zip (13.98 KB, 下载次数: 12)

2020-12-4 21:53 上传

点击文件名下载附件

qlmgu

cui26896 发表于 2020-12-4 21:54
请参考附件

cui26896 您好。您的作品很有效，很准确。能否请教您如果要减少或者增加表如何修改程序呢？想学习学习。谢谢您。

lsc900707

1. Sub gj23w98()
   
2.     Dim brr(1 To 9999, 1 To 3)
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     c = [av1].End(xlToLeft).Column + 3
   
5.     arr = [a1].Resize(r, c)
   
6.     For i = 2 To UBound(arr)
   
7.         For j = 1 To UBound(arr, 2) Step 6
   
8.             If arr(i, j + 2) = 1 Then
   
9.                 m = m + 1
   
10.                 For k = 1 To 3
    
11.                     brr(m, k) = arr(i, j + k - 1)
    
12.                 Next
    
13.             End If
    
14.         Next
    
15.     Next
    
16.     If m Then
    
17.         [a22].Resize(m, 3) = brr
    
18.     End If
    
19. End Sub

复制代码

lsc900707

这个是表内多个区域。测试附件：

cui26896

qlmgu 发表于 2020-12-4 22:47
cui26896 您好。您的作品很有效，很准确。能否请教您如果要减少或者增加表如何修改程序呢？想学习学习。 ...

因为你是要按表顺次来排列，每个表都用到了一个for i to ubound(arr),如果你的原始表都按你现在附件这样，在表顶端依次向右排列，只要增加一个for i to ubound(arr); for j x to y next , next就可以了，只是要注意x是第列，y是第几列，不要写错，就没有问题了。要减少，只要去掉一个完整循环，只保留第一个循环就可以了。

qlmgu

cui26896 发表于 2020-12-5 07:35
因为你是要按表顺次来排列，每个表都用到了一个for i to ubound(arr),如果你的原始表都按你现在附件这样 ...

谢谢您的指教，十分感谢。

qlmgu

lsc900707 发表于 2020-12-5 07:25
这个是表内多个区域。测试附件：

感谢您的帮助和编制的程序，谢谢了。