[已解决]怎样提高我这个VBA代码的运行效率？---请高手回答，菜鸟勿视

杨晨 · 发表于 2012-8-29 11:39

看起来很复杂实际上要求实现的功能很简单，我就是先把第一盘到第三十盘里面的数据先存到一个数组a中，然后再将a数组的数据一个一个写到另一个新文件中----这样就将杂乱无章的数据做的有顺序排列以便excel分析统计数据，注意原稿中有许多列是隐藏的，可以利用“展开”按钮查看---这里又有一个问题，我的展开和收拢都是使用循环实现的，效率也很低，有没有更快的方法实现？

其中的判断为列c，k，s，aa...中必须有数据，如果是数字，他左边一列相应行中也有数据的话就存到数组a中去，如果是s或“S”就只统计个数为P，如果是“排线不良”就只统计个数为q，最后用msgbox显示出来

每一盘里面的数据有a（16,7）个也就是16x7个，共三十盘，每盘之间有间隔而且每3盘重新置顶，这样在数据转换时搞得我晕头转向，虽然我勉强完成了这个转换，但是运行效率很低，你可以试着运行一下“生成文件”按钮对应的程序如下Sub form_file()，写的很慢----注意修改路径“C:\Documents and Settings\jackyang\桌面\”为你本地盘，有没有别的思路可以高效率的完成我要求的功能？

高手请解答，感激不尽！！！

Sub form_file()
Dim a(1 To 480, 1 To 7) As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

Dim m, n, p, q, h  As Integer
Dim r As Integer  'r=row
Dim c As Integer  'c=column
Dim StrDate As Date
Dim strFN As String
Dim wb As Workbook

'以下实现赋值给A矩阵，对所有有效数值，以SN和其后第一个数据不为空为判据

r = 1
p = 0
q = 0

For k = 0 To 9

For i = 9 To 58

If ((i - 8) Mod 17) <> 0 Then

If Cells(i, 2 + 11 * k) = "" And Cells(i, 3 + 11 * k) = "" Then

GoTo 100

If Cells(i, 3 + 11 * k) = "s" Or Cells(i, 3 + 11 * k) = "S" Then p = p + 1 'p为击穿不良个数
If Cells(i, 2 + 11 * k) = "" And Cells(i, 3 + 11 * k) = "排线不良" Then q = q + 1 'q为排线不良个数
Else:

For j = 1 To 7

a(r, j) = Cells(i, j + 11 * k + 1) '将数值挑选出来并赋值给矩阵a,这是关键

Next j
End If

r = r + 1  'r为合格个数，这里有问题

End If

Next i
Next k

100:  MsgBox ("良品个数=" & r - 1 & vbCrLf & "击穿个数=" & p & vbCrLf & "排线不良个数=" & q)    '& vbCrLf & "其他不良个数=" & q) '"总数=" & r - 1 + p + q & vbCrLf)    '&

' Open "C:\Documents and Settings\jackyang\桌面\StrFN.xls" For Input As #1
Set wb = Workbooks.Open("C:\Documents and Settings\jackyang\桌面\StrFN.xls")

For m = 1 To r - 1
For n = 1 To 7

Workbooks("strFN.xls").Worksheets(1).Cells(m, n) = a(m, n)  '将矩阵存得数据写到excel一个新文件中，这里运行特慢

Next n
Next m

  Columns("c:c").AutoFit
  Columns("f:f").AutoFit


'wb.Close True


End Sub

最佳答案

月排行榜 / 总排行榜

mxg825

2012-8-29 13:38

本帖最后由 mxg825 于 2012-8-29 15:35 编辑

按代码改动，没测试自己看看对不对？

顺便帮你把显示和隐藏列代码给优化了！

Option Explicit
Sub form_file()
Dim a(1 To 480, 1 To 7) As String
Dim arr
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m, n, p, q, h As Integer
Dim r As Integer 'r=row
Dim c As Integer 'c=column
Dim StrDate As Date
Dim strFN As String
Dim wb As Workbook
'以下实现赋值给A矩阵，对所有有效数值，以SN和其后第一个数据不为空为判据
r = 1
p = 0
q = 0
arr = ActiveSheet.UsedRange
For k = 0 To 9
For i = 9 To 58
If ((i - 8) Mod 17) <> 0 Then
If arr(i, 2 + 11 * k) = "" And arr(i, 3 + 11 * k) = "" Then
GoTo 100
If arr(i, 3 + 11 * k) = "s" Or arr(i, 3 + 11 * k) = "S" Then p = p + 1 'p为击穿不良个数
If arr(i, 2 + 11 * k) = "" And arr(i, 3 + 11 * k) = "排线不良" Then q = q + 1 'q为排线不良个数
Else
For j = 1 To 7
a(r, j) = arr(i, j + 11 * k + 1) '将数值挑选出来并赋值给矩阵a,这是关键
Next j
End If
r = r + 1 'r为合格个数，这里有问题
End If
Next i
Next k
100: MsgBox ("良品个数=" & r - 1 & vbCrLf & "击穿个数=" & p & vbCrLf & "排线不良个数=" & q) '& vbCrLf & "其他不良个数=" & q) '"总数=" & r - 1 + p + q & vbCrLf) '&
' Open "C:\Documents and Settings\jackyang\桌面\StrFN.xls" For Input As #1
Set wb = Workbooks.Open("C:\Documents and Settings\jackyang\桌面\StrFN.xls")
wb.Sheets(1).Range("A1").Resize(UBound(a, 1), UBound(a, 2)) = a '将矩阵存得数据写到excel一个新文件中
wb.Sheets(1).Range("C:C,F:F").Columns.AutoFit
wb.Close True
End Sub

复制代码

跳转到最佳答案楼层

fjmxwrs · 发表于 2012-8-29 11:48

本帖最后由 fjmxwrs 于 2012-8-29 11:54 编辑

你打开文件的次数多了，自然就慢了，你可以写到一个数组中，再一次性写入到新文件中即可。
另外，你的第某盘为什么不直接向下呢？只一个表头。这样不管是统计等工作都将方便得多了。

mxg825 · 发表于 2012-8-29 11:57

本帖最后由 mxg825 于 2012-8-29 12:06 编辑

For m = 1 To r - 1
For n = 1 To 7
Workbooks("strFN.xls").Worksheets(1).Cells(m, n) = a(m, n) '将矩阵存得数据写到excel一个新文件中，这里运行特慢
Next n
Next m

以上双循环简化为下面一句

WB.sheets(1).Range("A1").Resize(UBound(a, 1), UBound(a, 2)) = a '一次将矩阵存得数据写到excel一个新文件中，

复制代码

杨晨 · 发表于 2012-8-29 12:26

我i就是一次性写入的，只是使用了循环导致运行很慢，如果不使用循环而用write或print语句，它是按照顺寻全部写到第一列中去了---即将a（1,7）按顺序依次向下写到a（7,1）中了，这不是我想要的，我希望按照数组的排列写入数据，即a（1,7）写到A[1,1]-A[1,7]中，a（2,7）写到A[2,1]-A[2,7]中...这样可以使用write实现吗？那个文件指针是怎么用的呢？

杨晨 · 发表于 2012-8-29 12:28

你的第二个问题：另外，你的第某盘为什么不直接向下呢？只一个表头。这样不管是统计等工作都将方便得多了

回答：这是因为实际在输入数据的时候工人需要按照盘数来输入数据，必须给他们一个第莫盘的提示，我曾经尝试使用声控输入，但是环境噪音太大，不适合

柳如烟 · 发表于 2012-8-29 12:29

菜鸟绕道

杨晨 · 发表于 2012-8-29 12:33

对不起，刚次啊4楼5楼的回复是针对2楼的，3楼的回复我还没有仔细查看，现在正在研究。。。

无聊的疯子 · 发表于 2012-8-29 12:50

看着头大，，又一个把手写格式用到了电脑中，做出来一个中看不中用的文件！！

这种设计本身就适合用手写的，要用代码来处理的话，肯定就慢了！！

试想一下，叫你在一个N大的垃圾堆里去找几样东西，并且把他们排好再交出来，你觉得你的速度会很快吗？？

虽然不知道你们的具体操作流程是怎么样的，我个人认为该数据源表格可以不用这样设计！！

柳如烟 · 发表于 2012-8-29 13:13

“我希望按照数组的排列写入数据，即a（1,7）写到A[1,1]-A[1,7]中，a（2,7）写到A[2,1]-A[2,7]中...这样可以使用write实现吗？”

达到这个要求还不简单吗？做个小循环就行了。

杨晨 · 发表于 2012-8-29 13:18

8楼---无聊的疯子：
你说的很对，直接在源数据中就将格式做好是完全可以的，主要是别人用惯了以前的表格格式，想改变不好，另外如果使用excel统计方便的格式来录入数据，也有少许不便地方，就是下次如果从第10盘开始录入，要往下拉卷标查找，这个表就一目了然。我个人认为如果熟悉VBA的话做这个题目应该不算太难，共同学习，共同探讨。

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