[求助]如何通过VBA输入复杂的公式

烟雨厦江南 · 发表于 2005-9-1 12:42

我想通过VBA用循环的方式,在某列的连续单元格中输入比较复杂的公式,不知如何实现,请高手指点.

公式为:IF(A3="","",IF(SEARCH("/",A3)=3,VALUE(MID(A3,12,3)),IF(SEARCH("/",A3)=2,VALUE(MID(A3,11,3)),VALUE(MID(A3,10,3)))))

RQjKPaEz.rar (183.68 KB, 下载次数: 37) 在E至O列中输入如单元格中的公式,请LONGIII老师指点,谢谢!

[此贴子已经被作者于2005-9-1 13:00:14编辑过]

dghotman · 发表于 2005-9-1 12:55

先對第一個單元格設置你的公式, 然後用AutoFill來自動填充, 可快速完成, 而不用循環方式.以下例程僅供參考:

range("c1").Formula = "=a1 & "","" & b1"

range("c1").AutoFill Destination:=Range("C1:C3")

烟雨厦江南 · 发表于 2005-9-1 13:16

文件已上传

在E至O列中输入如单元格中的公式,请LONGIII老师指点,谢谢!

烟雨厦江南 · 发表于 2005-9-1 13:56

如此多谢Long_III兄了。

[此贴子已经被作者于2005-9-1 15:13:24编辑过]

烟雨厦江南 · 发表于 2005-9-1 15:30

实在是感谢，一定努力学习，争取自己做。

cofe2000 · 发表于 2005-9-1 15:36

龙兄的数组功夫是越来越出神入化拉[em02]

烟雨厦江南 · 发表于 2005-9-1 15:58

就是就是，因为我是刚学，另一个数据统计汇总的宏大概要5分钟，我对数组不了解，所以用的是CELLS（），很慢的。

我先试自己改改，要是不行，还要麻烦Long_III兄了。

Long_III · 发表于 2005-9-1 16:10

To 烟雨厦江南，在我的签名处链接的帖子里有关于数组的部分例子，楼主有空可以去看看

Long_III · 发表于 2005-9-1 15:40

兄台过奖了，这样的问题不用数组做，我怕速度不行啊

Long_III · 发表于 2005-9-1 15:26

我把你其他部分都删除了，只保留了相应的部分，你看看里面的代码，自己学习，掌握了就可以自己改 y6weq8Y6.rar (45.39 KB, 下载次数: 161)

由于数据有2000行，判断较多，运行时间约为2秒，代码如下：

Private Sub CommandButton1_Click() Dim arr Dim arr1() Dim irow%, i% Dim a, b Dim atime Dim c As Range

atime = Timer

Application.ScreenUpdating = False '关闭屏幕更新，防止闪屏及加快代码速度 irow = [a65536].End(xlUp).Row '计算A列非空得最后一行 arr = Range("a3:b" & irow) '把单元格赋值给数组

ReDim arr1(1 To irow - 2, 1 To 11) For i = 1 To irow - 2 a = Split(arr(i, 1), "-") '参考split函数哦 b = Split(a(0), "/")

arr1(i, 1) = b(0) arr1(i, 2) = b(1) arr1(i, 3) = b(2) arr1(i, 4) = a(1) arr1(i, 5) = IIf(UBound(a) > 1, a(UBound(a)), "") '前1～5列来自第一列单元格

Set c = Sheets("在线批号").Columns(1).Find(arr(i, 2), lookat:=xlWhole) If Not c Is Nothing Then arr1(i, 6) = c.Offset(0, 1) '第6列是根据批号来查找的 End If

arr1(i, 7) = Switch(arr1(i, 3) = 0, -1, arr1(i, 3) < 50, 1, arr1(i, 3) >= 50, 0) '第7列

If arr1(i, 4) = 0 Then '第8列的计算过程 arr1(i, 8) = -1 ElseIf (arr1(i, 3) / arr1(i, 4)) < (167 / 144) Then arr1(i, 8) = 1 Else arr1(i, 8) = 0 End If

arr1(i, 9) = IIf(arr1(i, 1) = "W", 1, 0) '第9列的计算过程

Set c = Sheets("在线批号").Columns(6).Find(arr1(i, 2), lookat:=xlWhole) If Not c Is Nothing Then arr1(i, 11) = c.Offset(0, 1) '第11列是根据纱种来查找的 End If

If arr1(i, 11) >= 1 Then arr1(i, 10) = 2 ElseIf arr1(i, 11) < 0 Then arr1(i, 10) = -1 ElseIf (arr1(i, 7) + arr1(i, 8)) > 0 Then arr1(i, 10) = 1 Else arr1(i, 10) = 0 '第10列的计算过程 End If

Application.ScreenUpdating = True MsgBox "Already Done!Total:=" & Format(Timer - atime, "0.00") & "s" '记录运算的时间

End Sub

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