[已解决]用代码求差数并删除商为负的列

阿柔

附件 求差数并删除商为负的列.rar (21.1 KB, 下载次数: 6)

2014-5-5 21:49 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2014-5-5 22:29

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, j&, n&
   
3. arr = ActiveSheet.UsedRange
   
4. n = UBound(arr)
   
5. ReDim brr(1 To 1, 1 To UBound(arr, 2))
   
6. For j = 1 To UBound(arr, 2)
   
7.     x = arr(n - 3, j) - arr(n - 2, j)
   
8.     If x >= 0 Then brr(1, j) = x
   
9. Next
   
10. With [a1].Offset(n - 2, 0).Resize(1, UBound(brr, 2))
    
11.     .Value = brr
    
12.     .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
    
13. End With
    
14. End Sub
    

复制代码

阿柔

dsmch 发表于 2014-5-5 22:21

老师您好，谢谢您帮助。测试了一下，出现报错。如下图：

dsmch

………………

阿柔

dsmch 发表于 2014-5-5 22:29
………………

老师您好，我测试您的附件，运行很正常。把另外的数据，复制进附件中，也很正常。但为什么，我把附件中的 代码 弄到另外一个工作薄中去，运行就不正常了。不知为何？因实际工作中，只需代码，无须附件。

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, j&, n&
   
3. h = Cells(Rows.Count, 1).End(xlUp).Row '行
   
4. l = Cells(1, Columns.Count).End(xlToLeft).Column '列
   
5. arr = Range("a1").Resize(h, l)
   
6. n = UBound(arr)
   
7. ReDim brr(1 To 1, 1 To UBound(arr, 2))
   
8. For j = 1 To UBound(arr, 2)
   
9.     x = arr(n - 3, j) - arr(n - 2, j)
   
10.     If x >= 0 Then brr(1, j) = x
    
11. Next
    
12. With [a1].Offset(n - 2, 0).Resize(1, UBound(brr, 2))
    
13.     .Value = brr
    
14.     .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
    
15. End With
    
16. End Sub
    

复制代码

阿柔

dsmch 发表于 2014-5-6 05:14

谢谢老师，试了一下，还是不行。