万能的EXCELHOME，帮我优化一个VB语句，在线急等（已解决）

handsomcao · 发表于 2011-7-20 14:53

我请高人帮我设计了一个VB，然后根据实际需要，加了一句，运行却很慢，帮我分析一下，
Sub test()
er = ActiveSheet.UsedRange.Rows.Count
Range("g4:s" & er).ClearContents
ProEr = [b65536].End(xlUp).Row
tr = 4

'五金配件发料管控表
For r = 4 To ProEr
成品代码 = Range("b" & r)
数量 = Range("d" & r)
With Sheets("BOM表")
   Ser = .[a65536].End(xlUp).Row
   For rr = 3 To Ser
      If .Range("a" & rr) = 成品代码 Then
         Range("g" & tr) = .Range("a" & rr)  '成品代码物料名称规格单位单位用量领料备注
         Range("h" & tr) = .Range("b" & rr)
         Range("i" & tr) = .Range("c" & rr)
         Range("j" & tr) = .Range("d" & rr)
         Range("k" & tr) = .Range("e" & rr)
         Range("l" & tr).Formula = "=k" & tr & "*" & 数量 '领料
         Range("m" & tr) = .Range("f" & rr)
      tr = tr + 1
      End If
      If .Range("h" & rr) = 成品代码 Then
         Range("g" & tr) = .Range("h" & rr)  '成品代码物料名称规格单位单位用量领料备注
         Range("h" & tr) = .Range("i" & rr)
         Range("i" & tr) = .Range("j" & rr)
         Range("j" & tr) = .Range("k" & rr)
         Range("k" & tr) = .Range("l" & rr)
         Range("l" & tr).Formula = "=k" & tr & "*" & 数量 '领料
         Range("m" & tr) = .Range("f" & rr)
      tr = tr + 1
      End If


   Next rr
End With
Next r
'领料单
'物料名称规格

ssr = [h65536].End(xlUp).Row

For r1 = 4 To ssr
   ttr = [o65536].End(xlUp).Row + 1
   物料名称 = Range("h" & r1)
   规格 = Range("i" & r1)
      For r2 = 4 To ttr
         If Range("p" & r2) = 物料名称 And Range("q" & r2) = 规格 Then
            ttr = r2
         End If
      Next r2
         '序号物料名称规格汇总备注
            Range("o" & ttr) = ttr - 3
            Range("p" & ttr) = Range("h" & r1)
            Range("q" & ttr) = Range("i" & r1)
            Range("r" & ttr) = Range("r" & ttr) + Range("l" & r1)
            Range("s" & ttr) = Range("f" & r1)

Next r1

End Sub

要加的是第二个IF，因为在实际操作中，BOM清单累加超过65536行，只有另起H列再加，

没人帮我？

[ 本帖最后由 handsomcao 于 2011-7-22 09:15 编辑 ]

handsomcao · 发表于 2011-7-20 18:41

认为不难啊

jiminyanyan · 发表于 2011-7-20 19:04

运行很慢的原因估计是对单元格操作很多，可以考虑用数组。

handsomcao · 发表于 2011-7-20 19:38

高手，帮我

kwinawyeth · 发表于 2011-7-20 20:25

Sub TEST()
Dim i As Long, j As Long, MyR As Long, MyC As Integer
Range("g4:s" & Cells(65536, 7).End(3).Row).ClearContents
MyR = 4
MyC = 7
With Sheets("BOM表")
      For i = 4 To Cells(65536, 2).End(3).Row
         For j = 3 To .Cells(65536, 1).End(xlUp).Row
            If Cells(i, 2) = .Cells(j, 1) Then
                  Cells(MyR, MyC) = .Cells(j, 1)  '成品代码
                  Cells(MyR, MyC + 1) = .Cells(j, 2) '物料名称
                  Cells(MyR, MyC + 2) = .Cells(j, 3) '规格
                  Cells(MyR, MyC + 3) = .Cells(j, 4) '单位
                  Cells(MyR, MyC + 4) = .Cells(j, 5) '单位
                  Cells(MyR, MyC + 5) = Cells(MyR, MyC + 4) * Cells(i, 4) '领料
                  Cells(MyR, MyC + 6) = .Cells(j, 6) '备注
                  MyR = MyR + 1 '增加一行输入
                  If MyR > 65536 Then '判断是否表格最后一行，是则开启下一系列
                     MyR = 4
                     MyC = MyC + 7
                  End If
            End If
         Next j
      Next i
End With
End Sub

由于时间关系没有设计完善，还有就是，既然用VBA了，表格里就尽量不要加公式，因为公式自动运算，会减慢运算速度。

AVEL · 发表于 2011-7-20 20:34

Dim arr, arr1, arr2, brr()
Dim i%, n%
Sub L()
With Sheet1
arr = .Range(.[a3], .[e65536].End(3))
arr2 = .Range(.[h3], .[l65536].End(3))
End With
With Sheet4
arr1 = .Range(.[b4], .[d65536].End(3))
End With
For i = 1 To UBound(arr1)
xh arr: xh arr2
Next
With Sheet4
.Range(.[g4], .[M65536]).ClearContents
.[g4].Resize(n, 6) = Application.Transpose(brr)
End With
Erase arr: Erase arr1: Erase arr2: Erase brr: n = 0
End Sub
Sub xh(ByVal a As Variant)
Dim j%
For j = 1 To UBound(a)
If a(j, 1) = arr1(i, 1) Then
n = n + 1
ReDim Preserve brr(1 To 6, 1 To n)
For k = 1 To 5
brr(k, n) = a(j, k)
Next
brr(6, n) = a(j, 5) * arr1(i, 3)
End If
Next
End Sub

复制代码

[ 本帖最后由 AVEL 于 2011-7-20 22:03 编辑 ]

handsomcao · 发表于 2011-7-20 20:38

老在，不行啊，帮帮手，BOM有二边，右手边上没反应啊

handsomcao · 发表于 2011-7-20 20:54

原帖由 AVEL 于 2011-7-20 20:34 发表
Sub L()
Dim arr, arr1, arr2, brr()
Dim i%, j%, n%
With Sheet1
arr = .Range(.[a3], .[e65536].End(3))
arr2 = .Range(.[h3], .[l65536].End(3))
End With
With Shee ...

这个可用，但没有汇总啊，老大，在线急等

handsomcao · 发表于 2011-7-20 21:00

急等着你，先用你这个，汇总就交给透析吧

office2008 · 发表于 2011-7-20 21:19

都是循环套循环，为何不用字典，一遍循环呢？

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

[求助] 万能的EXCELHOME，帮我优化一个VB语句，在线急等（已解决）

怎么没人帮我啊

能帮我设计一下吗

没有用啊

如果，不能实现，也没关系