按部门跨表同时按名称排序提取数据

icenotcool · 发表于 2024-10-6 14:20

本帖最后由 icenotcool 于 2024-10-6 16:37 编辑

Qs18 发表于 2024-10-6 13:33
可以，您可以把字典k的数据，换一个表就可以了，您自己的业务肯定您自己会轻车熟路。
我换了表，在sheet4表添加了，但是没有反应，是不是我改错了,可以指点一下吗？
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Sheet1.[c2] Then
Dim arr, i
arr = Sheet3.Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
s = Sheet1.[c2].Value
For i = 2 To UBound(arr)
If s = arr(i, 10) Then
      m = m + 1
      For c = 2 To UBound(arr, 2)
         brr(m, c) = arr(i, c)
      Next
      brr(m, 1) = m
End If
Next
Sheet4.Range("a2").Resize(10000, 20) = ""
Sheet4.Range("a2").Resize(m, UBound(arr, 2)) = brr
End If
End Sub

Qs18老师，我想用你那个单元格内容变动的模块该怎么修改呢？不是按钮模块，麻烦你了

icenotcool · 发表于 2024-10-6 14:24

ykcbf1100 发表于 2024-10-6 12:32
查询。。。

谢谢ykcbf1100老师的解答

icenotcool · 发表于 2024-10-6 14:24

longwin 发表于 2024-10-6 13:27
附件供参考。。。。

谢谢longwin老师的帮助

aiyou1124 · 发表于 2024-10-6 19:27

自动化执行请查收

icenotcool · 发表于 2024-10-6 20:54

aiyou1124 发表于 2024-10-6 19:27
自动化执行请查收

谢谢，但是我的问题有了变化

lss001 · 发表于 2024-10-6 21:09

本帖最后由 lss001 于 2024-10-6 23:20 编辑

见以下楼附件代码

icenotcool · 发表于 2024-10-6 22:12

lss001 发表于 2024-10-6 21:09
Sub 部门资产盘点表() '模块A代码
Dim x&, y&, m&, i&, j&, n$
Dim sht As Worksheet, arr, br ...

lss011老师，不好意思，可否通过单元格内容变化来提取更新内容呢，麻烦您啦

icenotcool · 发表于 2024-10-6 22:37

lss001 发表于 2024-10-6 21:09
Sub 部门资产盘点表() '模块A代码
Dim x&, y&, m&, i&, j&, n$
Dim sht As Worksheet, arr, br ...

lss001老师你的这两个模块运行没有反应，也没有报错，可否按我的要求直接在我的附件里修改上传呢，谢谢你了

lss001 · 发表于 2024-10-6 23:21

icenotcool 发表于 2024-10-6 22:37
lss001老师你的这两个模块运行没有反应，也没有报错，可否按我的要求直接在我的附件里修改上传呢，谢谢你 ...

见附件代码

lss001 · 发表于 2024-10-6 23:23

icenotcool 发表于 2024-10-6 22:37
lss001老师你的这两个模块运行没有反应，也没有报错，可否按我的要求直接在我的附件里修改上传呢，谢谢你 ...

示例20241006new.rar (58.67 KB, 下载次数: 17)

		自动登录	找回密码
密码			免费注册

[求助] 按部门跨表同时按名称排序提取数据