多条件 多区域 查询 填充 求大神搭把手！！

caizhiliang

多条件  多区域  查询  填充   求大神搭把手！！

1. Sub ddddd()
   
2. Range("A6:v100").ClearContents  '清空页面指定区域内容
   
3. Dim brr()
   
4. arr = Sheet5.[a2].CurrentRegion '数据库查询起始段
   
5. For i = 3 To UBound(arr)
   
6. If Sheet4.[a3] & [c3] & [d3] = arr(i, 21) & arr(i, 22) & arr(i, 23) Then '查找对应区域
   
7. n = n + 1
   
8. ReDim Preserve brr(1 To 5, 1 To n)
   
9. brr(2, n) = arr(i, 18)  'brr（1，n）写入位置  arr(i, 6)读取内容位置
   
10. brr(3, n) = arr(i, 19)
    
11. brr(4, n) = arr(i, 20)
    
12. brr(5, n) = arr(i, 1)
    
13. brr(6, n) = arr(i, 2)
    
14. End If
    
15. Next
    
16. Sheet4.[a6].Resize(UBound(brr, 2), 5) = Application.Transpose(brr)
    
17. 'Sheet3.[a6]开始写入起始点
    
18. End Sub

复制代码

这是网上找的一段代码  可是修改后没有反应

sub麻辣君

你的原代码的话，可以这样修改
Sub ddddd()
   Range("A6:v100").ClearContents  '清空页面指定区域内容
   Dim brr()
   arr = Sheet5.[a2].CurrentRegion '数据库查询起始段
   For i = 3 To UBound(arr)
      If Sheet4.[a3] & Sheet4.[c3] & Sheet4.[d3] = arr(i, 21) & arr(i, 22) & arr(i, 23) Then '查找对应区域
         n = n + 1
         ReDim Preserve brr(1 To 6, 1 To n)
         brr(2, n) = arr(i, 18)  'brr（1，n）写入位置  arr(i, 6)读取内容位置
         brr(3, n) = arr(i, 17)
         brr(4, n) = arr(i, 19)
         brr(5, n) = arr(i, 1)
         brr(6, n) = arr(i, 2)
      End If
   Next
   If Empt(arr) Then
      MsgBox "未找到"
   Else
      Sheet4.[a6].Resize(UBound(brr, 2), 5) = Application.Transpose(brr)
   End If
   'Sheet3.[a6]开始写入起始点
End Sub
Public Function Empt(arr)
    Dim i&
    On Error Resume Next
    i = UBound(arr)
    If Err = 0 Then Empt = True
End Function

caizhiliang

自己先顶上去   路过的帮顶一下 不要沉了

caizhiliang

不要沉了   集齐七个龙珠  能否召唤大神

caizhiliang

有没有人出手帮助下这个菜鸟呀
没有我待会再问问