[已解决]vba写代码实现以下功能

hanyu286613818

点击汇总 “查询”表格里数据数量不为0的数据导入到明细里，编号自动加1，在输一个编号的话，点击汇总，明细表接着输入

最佳答案

月排行榜 / 总排行榜

那么的帅

2013-5-21 15:48

hanyu286613818 发表于 2013-5-21 15:43
往里面加代码啊 ，在做一张表 就是直接替换原来的表了  我要的是接着后面的输入到明细表里

试试这个

1. Sub 宏1()
   
2.     Dim arr, brr(), i&, j&, m&, lc%
   
3.     arr = [a1].CurrentRegion
   
4.     lc = UBound(arr, 2)
   
5.     ReDim brr(1 To UBound(arr), -1 To lc)
   
6.     brr(1, -1) = [b3]
   
7.     brr(1, 0) = [c4]
   
8.     For i = 6 To UBound(arr)
   
9.         If arr(i, 7) > 0 Then
   
10.             m = m + 1
    
11.             For j = 1 To lc
    
12.                 brr(m, j) = arr(i, j)
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     With Sheets("明细")
    
17.         '.UsedRange.Offset(2, 1).ClearContents
    
18.         ROW1 = .Range("G" & .Rows.Count).End(xlUp).Row
    
19.         .Range("B" & ROW1 + 1).Resize(m, lc + 2) = brr
    
20.     End With
    
21. End Sub

复制代码

跳转到最佳答案楼层

那么的帅

不是已经有代码了吗？
不知道 楼主还有什么要求？

hanyu286613818

那么的帅 发表于 2013-5-21 15:32
不是已经有代码了吗？
不知道 楼主还有什么要求？

往里面加代码啊 ，在做一张表 就是直接替换原来的表了  我要的是接着后面的输入到明细表里

那么的帅

hanyu286613818 发表于 2013-5-21 15:43
往里面加代码啊 ，在做一张表 就是直接替换原来的表了  我要的是接着后面的输入到明细表里

试试这个

1. Sub 宏1()
   
2.     Dim arr, brr(), i&, j&, m&, lc%
   
3.     arr = [a1].CurrentRegion
   
4.     lc = UBound(arr, 2)
   
5.     ReDim brr(1 To UBound(arr), -1 To lc)
   
6.     brr(1, -1) = [b3]
   
7.     brr(1, 0) = [c4]
   
8.     For i = 6 To UBound(arr)
   
9.         If arr(i, 7) > 0 Then
   
10.             m = m + 1
    
11.             For j = 1 To lc
    
12.                 brr(m, j) = arr(i, j)
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     With Sheets("明细")
    
17.         '.UsedRange.Offset(2, 1).ClearContents
    
18.         ROW1 = .Range("G" & .Rows.Count).End(xlUp).Row
    
19.         .Range("B" & ROW1 + 1).Resize(m, lc + 2) = brr
    
20.     End With
    
21. End Sub

复制代码