Question

上下文

我在一家生产/加工金属零件的生产工厂工作，因此我们有锯切，铣削，CNC车削等多种操作。

工作表WData包含一个包含商品编号和数量的简单列表。
工作表WRouting包含WData中每个路由具有多个操作的项目的路由。因此WData中的每个项目都在WRouting中有一行或多行。

我们的想法是构建一个宏：

从WData中的第一项开始。
循环WRouting中的路线。
当找到该项目时，它会计算此项目的操作次数，并在WData
将WRouting中的一些其他信息复制到WData。

因此，如果一个项目在WRouting中有4个操作，则应在该项目的第一行下方的WData添加3个新行。

代码

我的尝试代码如下。它非常慢，占用了大量资源，当我插入大量物品（即1000件物品）时，它经常会崩溃......

WData.Activate
MyRowData = 2
MyRowRouting = 2

WRouting.Activate
WRouting.Range("A1").Activate
WRouting.Range("A1:Z1").Find(What:="Maakartikel  ", After:=ActiveCell, 
    LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext, 
    MatchCase:=False, SearchFormat:=False).Activate
A = ActiveCell.Column + 1

WRouting.Activate
WRouting.Range("A1").Activate
WRouting.Range("A1:Z1").Find(What:="Afdeling  ", After:=ActiveCell, 
    LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext, 
    MatchCase:=False, SearchFormat:=False).Activate
R = ActiveCell.Column

WRouting.Range("A1").Activate
WRouting.Range("A1:Z1").Find(What:="Machine  ", After:=ActiveCell, 
    LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext, 
    MatchCase:=False, SearchFormat:=False).Activate
M = ActiveCell.Column

WRouting.Range("A1").Activate
WRouting.Range("A1:Z1").Find(What:="Gemiddelde omsteltijd [min] ", 
    After:=ActiveCell, LookIn:=xlValues, SearchOrder:=xlByRows, 
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
S = ActiveCell.Column

WRouting.Range("A1").Activate
WRouting.Range("A1:Z1").Find(What:="Cyclustijd [min]  ", After:=ActiveCell, 
    LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext, 
    MatchCase:=False, SearchFormat:=False).Activate
C = ActiveCell.Column

Do
    If IsEmpty(WRouting.Cells(MyRowRouting, A)) Then 

        Do
            If IsEmpty(WData.Cells(MyRowData, 2)) Then 
            GoTo Door

            Else
            MyRowRouting = 2 
            MyRowData = MyRowData + 1 
            Exit Do

          End If
        Loop


    ElseIf WRouting.Cells(MyRowRouting, A) = WData.Cells(MyRowData, 2) Then 
        firstrow = MyRowRouting 
        Do
            If WRouting.Cells(MyRowRouting, A) = WData.Cells(MyRowData, 2) Then 
                 MyRowRouting = MyRowRouting + 1 
            Else
                Lastrow = MyRowRouting - 1 
                aantal = 0

                For I = firstrow To Lastrow
                    aantal = aantal + 1
                    If aantal > 1 Then
                        WData.Activate
                        WData.Rows(MyRowData + aantal - 1).Insert Shift:=xlShiftDown
                        WData.Rows(MyRowData).Copy
                        WData.Cells(MyRowData + aantal - 1, 1).Select
                        WData.Paste
                    End If                                

                    WData.Cells(MyRowData + aantal - 1, 7).Value = WRouting.Cells(I, R).Value                                
                    WData.Cells(MyRowData + aantal - 1, 8).Value = WRouting.Cells(I, M).Value                                
                    WData.Cells(MyRowData + aantal - 1, 9).Value = WRouting.Cells(I, S).Value                                
                    WData.Cells(MyRowData + aantal - 1, 10).Value = WRouting.Cells(I, C).Value                        
                Next I

                MyRowRouting = 2 
                MyRowData = MyRowData + (aantal - 1) + 1 
                Exit Do
            End If
        Loop
    ElseIf IsEmpty(WData.Cells(MyRowData, 2)) Then
        Exit Do
    Else
        MyRowRouting = MyRowRouting + 1
    End If
Loop

我希望上面的代码是有道理的，有些变量是荷兰语，我希望这些变量不会太混乱。

我的主要问题

如何优化此代码，使其运行至少稳定？
我的逻辑和我对VBA语法的使用是否正确？

根据单独工作表中的项目循环列表并添加新行

0 个答案: