|
看起来很复杂实际上要求实现的功能很简单,我就是先把第一盘到第三十盘里面的数据先存到一个数组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 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
复制代码
|
|