|
发表于 2016-5-29 11:27
|
显示全部楼层
本楼为最佳答案
本帖最后由 老司机带带我 于 2016-5-29 11:30 编辑
用数组逐个赋值,不要直接将数组赋值到单元格区域:
另外,n = zb.Range("a65536").End(xlUp).Row当存在筛选状态时这个值你可以测试一下也并不是你想的那个值!另外你超链接的那个循环也可以放到赋值的循环中去,这样可以少一个FOR循环,这个你自己看下吧!
- Private Sub Worksheet_Activate()
- Dim x As Integer
- Dim y As Integer
- Dim n As Integer
- Dim n1 As Integer
- Dim zb As Worksheet
- Dim fb As Worksheet
- Dim i As Integer
- Dim rg As Range
- Dim arr1(1 To 10000, 1 To 12), arr2()
- Application.ScreenUpdating = False
- Set zb = Sheets("订单汇总")
- n = zb.Range("a65536").End(xlUp).Row
- 'MsgBox n
- 'If n > 2 Then zb.Range("A3:L" & n).ClearContents
- zb.Range("A3:L65536").ClearContents
- For i = 2 To Sheets.Count
- Set fb = Sheets(i)
- If fb.Name <> "基础数据" And fb.Name <> "未完成订单汇总" And fb.Name <> "订单模板" And fb.Name <> "信息汇总" Then
- n1 = fb.Range("a65536").End(xlUp).Row '计算分表的行数
- If n1 = 6 Then GoTo 100 '分表没有内容自动跳过去
- arr2 = fb.Range("A2:J" & n1) '将分表生成数组2
- For y = 6 To UBound(arr2) '分表循环
- If arr2(y, 10) <> "取消" Then
- x = x + 1
- arr1(x, 1) = arr2(1, 10)
- arr1(x, 2) = arr2(y, 1)
- arr1(x, 3) = arr2(y, 2)
- arr1(x, 4) = arr2(y, 3)
- arr1(x, 5) = arr2(2, 4)
- arr1(x, 6) = arr2(2, 6)
- arr1(x, 7) = arr2(y, 4)
- If arr2(2, 8) = "" Then
- arr1(x, 8) = ""
- arr1(x, 9) = "交期未定"
- Else
- arr1(x, 8) = arr2(2, 8)
- arr1(x, 9) = arr2(2, 8) - Date
- End If
- arr1(x, 10) = arr2(y, 4) - arr2(y, 9)
- If arr1(x, 10) < 0 Or arr1(x, 10) = 0 Then
- arr1(x, 10) = 0
- arr1(x, 11) = "已完成"
- arr1(x, 9) = ""
- Else
- arr1(x, 11) = "未完成"
- End If
- arr1(x, 12) = arr2(3, 10)
- End If
- Next y '分表循环结束
- End If
- 100: Next i
- If x = 0 Then Exit Sub
- For i = 1 To x
- For j = 1 To 12
- zb.Cells(i + 2, j) = arr1(i, j)
- Next
- Next
- For d = 3 To x + 2
- zb.Range("A" & d).Hyperlinks.Add zb.Range("A" & d), "", "'" & zb.Range("A" & d).Value & "'!A1"
- Next d
- Application.ScreenUpdating = True
- Beep
- End Sub
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- If Target.Column > 1 Then
- 'Cells(1, 1).Select
- End If
- End Sub
复制代码 |
|