敬请老师帮忙修改代码，非常感谢！

LSYYLW

2024-5-8-.zip (8.25 KB, 下载次数: 14)

2024-5-8 09:06 上传

点击文件名下载附件

hlxue

是要这样吗？请给好评+2分，谢谢！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address = "$M$1" Then
   
3.         num = Me.[m1]
   
4.         r = Me.Cells(Rows.Count, 2).End(3).Row
   
5.         arr = Me.[a1].Resize(r, 11)
   
6.         ReDim brr(1 To r, 1 To 1)
   
7.         For j = 2 To UBound(arr, 2)
   
8.             If arr(1, j) = num Then
   
9.                 For i = 3 To UBound(arr)
   
10.                     m = m + 1
    
11.                     brr(m, 1) = arr(i, j)
    
12.                 Next
    
13.             End If
    
14.         Next
    
15.         Me.[m3].Resize(m, 1) = brr
    
16.         '        If k = 0 Then
    
17.         '            m1 = Range("b" & Rows.Count).End(3).Row
    
18.         '            arr = Range("b1:k1")
    
19.         '            w = Application.Match(l, arr, 0)
    
20.         '            a = Range("a3:a" & m1).Offset(0, w)
    
21.         '        End If
    
22.         '        Range("m3").Resize(UBound(a), 1) = a
    
23.     End If
    
24. End Sub

复制代码

quqiyuan

重新写了额，供参考

cidanji

LSYYLW

hlxue 发表于 2024-5-8 09:15
是要这样吗？请给好评+2分，谢谢！

非常感谢老师，就是这样！

LSYYLW

ykcbf1100 发表于 2024-5-8 09:20
附件供参考。。。

非常感谢老师，代码非常好用。

LSYYLW

quqiyuan 发表于 2024-5-8 09:27
重新写了额，供参考

非常感谢老师，代码非常好用。