☰

2010 Excel 中的 VBA 代码调试

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 microsoft-excel-2007 vba macros
2010 Excel 中的 VBA 代码调试

寻求一些帮助来调试一些旧的 VBA/宏代码，以便在较新版本的 MS Excel 2010 中运行。有问题的宏是“Material Rollup”功能。

该宏的作用是在选定给定列中的连续单元格区域后，将对应信息区域 (B?:H?) 的信息复制到新工作表或现有工作表中，并根据“部分编号”列 (D) 中的值对信息进行排序。

到目前为止，宏按预期工作。但是当它尝试合并具有类似“零件号”的项目并删除重复条目时，它会出错。如果您能给我提供任何帮助或协助，我将不胜感激。

他们认为错误/故障始于以下行“汇总、类似零件编号、合并数量和删除行”。

下面是已经成为我生活祸根的 VBA 代码。

'**************************  Material Rollup by Part Number  *****************************
Function Material_Rollup()

    MyfirstValue = 0
    MyLastValue = 0
    Cnt = 0
    TopRow = 0
    BottomRow = 0
    CntDelRows = 0
    NewLastRow = 0
    Quantity = 0
    loopCnt = 0
    Dim MyBom As String
    Dim MyRollup As String
    Dim NextRow As String

    MyBom = ActiveSheet.Name

    If Val(Range("A2")) > 0 Or Val(Range("I1")) > 0 Then
        MsgBox MyBom & " is not a BOM72 Work sheet or Material Rollup Sheet, Rollup Canceled."
        Call GotoSheet
        GoTo Cancel
    End If

    ReturnRows (Selection.Address)
    MyfirstValue = My_First_Row
    MyLastValue = My_Last_Row

    If MyfirstValue = MyLastValue Then
        Call BOM72ERR(3, "")
        GoTo Cancel
    End If

RetrySheet:
     'Provide List of existing Sheets and input box for new Sheet Name
     ListSheets (2)

        If Pick_Sheet = "Pick_Sheet_Cancel" Then
            Sheets(MyBom).Select
            GoTo Cancel
           Else
           MyRollup = Pick_Sheet
         End If

     'See if Rollup sheet name exist or is new
    For Each sh In ActiveWorkbook.Sheets

            If UCase(sh.Name) = UCase(MyRollup) Then
                DoesSheetExist = 1
                Exit For
            Else
                DoesSheetExist = 0
            End If
    Next
    'If Sheet exist make sure its a Material Rollup Sheet
    If DoesSheetExist = 1 Then
        If Worksheets(MyRollup).Range("E1").Value <= 0 Then
                MsgBox MyRollup & " is not a Material Rollup Sheet."
        GoTo RetrySheet
        End If
    End If

    'If sheet doesn't exist, build and format
    If DoesSheetExist = 0 Then

        Sheets.Add
        ActiveSheet.Name = MyRollup
        ActiveWindow.DisplayGridlines = False
        With Application
            .Calculation = xlManual
            .MaxChange = 0.001
        End With
        ActiveWorkbook.PrecisionAsDisplayed = False

        Worksheets("Data").Range("A4:W6").Copy (Worksheets(MyRollup).Range("A1"))

        Range("a4").Select
        ActiveWindow.FreezePanes = True

         Range("A5").Select

        TopRow = 4
        Range("E1") = TopRow
    End If

    Worksheets(MyRollup).Select
    TopRow = (Range("E1") + 1)
    BottomRow = ((Val(MyLastValue) - Val(MyfirstValue)) + 1) + Range("E1").Value
    Cnt = TopRow

    Worksheets(MyBom).Range("B" + MyfirstValue + ":H" + MyLastValue).Copy (Worksheets(MyRollup).Range("B" & TopRow))

    'Delete Rows that are not Material Items (Look for Text in Mfg Column)
    For Each C In Worksheets(MyRollup).Range("C" & TopRow & ":C" & BottomRow)

           If C.Value = "" Then
               Rows((Cnt - CntDelRows)).Select
               Selection.Delete Shift:=xlUp
               CntDelRows = CntDelRows + 1

            End If

               Cnt = Cnt + 1
    Next C


    'Delete Rows with the Unit Price column colored Gray (Don't Rollup)
    NewLastRow = (Cnt - (CntDelRows + 1))
    Cnt = TopRow
    CntDelRows = 0
    For Each C2 In Worksheets(MyRollup).Range("G" & TopRow & ":G" & NewLastRow)

           If C2.Interior.ColorIndex = 40 Then
               Rows((Cnt - CntDelRows)).Select
               Selection.Delete Shift:=xlUp
               CntDelRows = CntDelRows + 1

            End If

                Cnt = Cnt + 1

    Next C2


    NewLastRow = (Cnt - (CntDelRows + 1))


    'Sort Rollup by Part Number
    Range("A" & TopRow & ":S" & NewLastRow).Select
    Selection.Sort Key1:=Range("D" & TopRow), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    Range("B" & TopRow).Select

     Cells.Select
     With Selection.Font
         .Name = "Arial"
         .FontStyle = "Regular"
            .Size = 10
     End With
     Range("A1").Select

    Cnt = TopRow
    cnt2 = (Cnt + 1)
    CntDelRows = 0
    loopCnt = 0


    'Rollup, Like Part Numbers, Combine Quantities and Delete Rows
    For Each c1 In Worksheets(MyRollup).Range("D" & TopRow + ":D" & NewLastRow)

            NextRow = Range("D" & cnt2)

           If UCase(c1.Value) = UCase(NextRow) Then
              Quantity = Range("E" & Cnt) + Range("E" & cnt2)
              Range("E" & cnt2) = Quantity
              Rows(Cnt).Select
              Selection.Delete Shift:=xlUp
              CntDelRows = CntDelRows + 1
              Cnt = Cnt - 1
              cnt2 = cnt2 - 1
              Quantity = 0
           End If

             Cnt = (Cnt + 1)
             cnt2 = (cnt2 + 1)

    Next c1
        NewLastRow = NewLastRow - CntDelRows

        'Sort Rollup by Manufacturer then Part Number
        Range("A" & TopRow & ":S" & NewLastRow).Select
        Selection.Sort Key1:=Range("C" & TopRow), Order1:=xlAscending, Key2:=Range _
        ("D" & TopRow), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom

        Range("B" + TopRow).Select
        Worksheets("Data").Range("G8:W8").Copy Worksheets(MyRollup).Range("G" & TopRow & ":G" & NewLastRow)
        Sheets(MyRollup).Select

        Columns("K:S").Select
        Selection.ColumnWidth = 6
        Columns("A").Select
        Selection.ColumnWidth = 3
        Columns("B").Select
        Selection.ColumnWidth = 20
        Columns("C:D").Select
        Selection.ColumnWidth = 12
        Columns("E:F").Select
        Selection.ColumnWidth = 6
        Columns("H").Select
        Selection.ColumnWidth = 3

        Range("K5").Select

        With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
        End With
        ActiveWorkbook.PrecisionAsDisplayed = False
        Range("E1") = NewLastRow
        Range("A" & TopRow) = "WorkSheet: " & MyBom & "    Rows: " & MyfirstValue & " to " & MyLastValue
        Range("A" & TopRow).Font.ColorIndex = 22
        If TopRow > 5 Then
            Range("B1") = "Multi-Rollup Sheet"
            Else
            Range("B1") = "Single-Rollup Sheet"
        End If
        Range("B" + TopRow).Select
        'Don't forget to value quantity column
Cancel:
End Function

感谢您提供的任何帮助。

答案1

那个“+”是错误的。

你连接字符串与&和添加数字和+。

假设 TopRow = 1，且 NewLastRow = 5：

您尝试将“D1”添加到“：D5”，但由于您无法对字符串执行数学加法，因此尝试时会出现类型不匹配错误。

除此之外 - 没有语法错误的输出值问题是逻辑问题，为了帮助解决这些问题，我们需要其他特定信息。因此，最好将这些作为新问题处理（并提供适当的信息），以便在您完成调查工作后，我们可以一次解决您遇到的问题。:)

答案2

 
1. 我注意到& 和+ 混合在一起。
   1a. 我修复了它们。

2. 我认为你需要转换整数到字符串（TopRow、NewLastRow、其他）。
   2a. 我为你铸造它们。

我完全按照您的代码剪切了代码。

我添加了一些注释，剪切并粘贴后您将看到绿色注释。

我在 Range 字段中添加了对整数的转换。

如果您的代码正确，它现在就可以工作了。如果仍然出现 Err，那么您必须查看一些逻辑。使用一些调试来向自己发送消息，例如 MsgBox “尝试代码 var：” & myvar


Function Material_Rollup()

MyfirstValue = 0
MyLastValue = 0
Cnt = 0
TopRow = 0
BottomRow = 0
CntDelRows = 0
NewLastRow = 0
Quantity = 0
loopCnt = 0
Dim MyBom As String
Dim MyRollup As String
Dim NextRow As String

MyBom = ActiveSheet.Name

If Val(Range("A2")) > 0 Or Val(Range("I1")) > 0 Then
    MsgBox MyBom & " is not a BOM72 Work sheet or Material Rollup Sheet, Rollup Canceled."
    Call GotoSheet
    GoTo Cancel
End If

ReturnRows (Selection.Address)
MyfirstValue = My_First_Row
MyLastValue = My_Last_Row

If MyfirstValue = MyLastValue Then
    Call BOM72ERR(3, "")
    GoTo Cancel
End If
RetrySheet:

If Pick_Sheet = "Pick_Sheet_Cancel" Then
        Sheets(MyBom).Select
        GoTo Cancel
       Else
       MyRollup = Pick_Sheet
     End If

 'See if Rollup sheet name exist or is new
For Each sh In ActiveWorkbook.Sheets

        If UCase(sh.Name) = UCase(MyRollup) Then
            DoesSheetExist = 1
            Exit For
        Else
            DoesSheetExist = 0
        End If
Next
'If Sheet exist make sure its a Material Rollup Sheet
If DoesSheetExist = 1 Then
    If Worksheets(MyRollup).Range("E1").Value <= 0 Then
            MsgBox MyRollup & " is not a Material Rollup Sheet."
    GoTo RetrySheet
    End If
End If

'If sheet doesn't exist, build and format
If DoesSheetExist = 0 Then

    Sheets.Add
    ActiveSheet.Name = MyRollup
    ActiveWindow.DisplayGridlines = False
    With Application
        .Calculation = xlManual
        .MaxChange = 0.001
    End With
    ActiveWorkbook.PrecisionAsDisplayed = False

    Worksheets("Data").Range("A4:W6").Copy (Worksheets(MyRollup).Range("A1"))

    Range("a4").Select
    ActiveWindow.FreezePanes = True

     Range("A5").Select

    TopRow = 4

    'Does Range("E1") return an address or integer?
    Dim myMessage = "Range("E1") return an address or integer? TopRow = "     

    Range("E1") = TopRow

    MsgBox myMessage & TopRow

End If

Worksheets(MyRollup).Select

'
'TopRow = Address + 1? Does Range("E1") return an integer?

TopRow = (Range("E1") + 1)

MsgBox myMessage & TopRow

'Is Val(MyFirstValue), Val necessary, or help, or hinder?


BottomRow = ((Val(MyLastValue) - Val(MyfirstValue)) + 1) + Range("E1").Value
Cnt = TopRow

'Casting
Worksheets(MyBom).Range("B" + CStr(MyfirstValue) & ":H" & CStr(MyLastValue)).Copy (Worksheets(MyRollup).Range("B" & CStr(TopRow)))

'Delete Rows that are not Material Items (Look for Text in Mfg Column)
For Each C In Worksheets(MyRollup).Range("C" & CStr(TopRow) & ":C" & CStr(BottomRow))

       If C.Value = "" Then
           'Added Cast to summation
           Rows(CStr((Cnt - CntDelRows))).Select
           Selection.Delete Shift:=xlUp
           CntDelRows = CntDelRows + 1

        End If

           Cnt = Cnt + 1
Next C


'Delete Rows with the Unit Price column colored Gray (Don't Rollup)
NewLastRow = (Cnt - (CntDelRows + 1))
Cnt = TopRow
CntDelRows = 0

'Casting
For Each C2 In Worksheets(MyRollup).Range("G" & CStr(TopRow) & ":G" & CStr(NewLastRow))

       If C2.Interior.ColorIndex = 40 Then
           Rows((Cnt - CntDelRows)).Select
           Selection.Delete Shift:=xlUp
           CntDelRows = CntDelRows + 1

        End If

            Cnt = Cnt + 1

Next C2


NewLastRow = (Cnt - (CntDelRows + 1))


'Sort Rollup by Part Number
'Casting
Range("A" & CStr(TopRow) & ":S" & CStr(NewLastRow)).Select
Selection.Sort Key1:=Range("D" & TopRow), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("B" & TopRow).Select

 Cells.Select
 With Selection.Font
     .Name = "Arial"
     .FontStyle = "Regular"
        .Size = 10
 End With
 Range("A1").Select

Cnt = TopRow
cnt2 = (Cnt + 1)
CntDelRows = 0
loopCnt = 0

'Casting
'Rollup, Like Part Numbers, Combine Quantities and Delete Rows
For Each c1 In Worksheets(MyRollup).Range("D" & CStr(TopRow) + ":D" & CStr(NewLastRow))

        NextRow = Range("D" & cnt2)

       'Casting
       If UCase(c1.Value) = UCase(NextRow) Then
          Quantity = Range("E" & CStr(Cnt)) & Range("E" & CStr(cnt2))
          Range("E" & CStr(cnt2)) = Quantity

          '?Cast here? CStr(Cnt)?

          Rows(Cnt).Select
          Selection.Delete Shift:=xlUp
          CntDelRows = CntDelRows + 1
          Cnt = Cnt - 1
          cnt2 = cnt2 - 1
          Quantity = 0
       End If

         Cnt = (Cnt + 1)
         cnt2 = (cnt2 + 1)

Next c1
    NewLastRow = NewLastRow - CntDelRows

    'Casting
    'Sort Rollup by Manufacturer then Part Number
    Range("A" & CStr(TopRow) & ":S" & CStr(NewLastRow)).Select
    Selection.Sort Key1:=Range("C" & CStr(TopRow)), Order1:=xlAscending, Key2:=Range _
    ("D" & CStr(TopRow)), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
    MatchCase:=False, Orientation:=xlTopToBottom

    'Casting
    Range("B" + CStr(TopRow)).Select
    Worksheets("Data").Range("G8:W8").Copy Worksheets(MyRollup).Range("G" & CStr(TopRow) & ":G" & CStr(NewLastRow))
    Sheets(MyRollup).Select

    Columns("K:S").Select
    Selection.ColumnWidth = 6
    Columns("A").Select
    Selection.ColumnWidth = 3
    Columns("B").Select
    Selection.ColumnWidth = 20
    Columns("C:D").Select
    Selection.ColumnWidth = 12
    Columns("E:F").Select
    Selection.ColumnWidth = 6
    Columns("H").Select
    Selection.ColumnWidth = 3

    Range("K5").Select

    With Application
    .Calculation = xlAutomatic
    .MaxChange = 0.001
    End With
    ActiveWorkbook.PrecisionAsDisplayed = False

    'Casting
    Range("E1") = NewLastRow          '? CStr(NewLastRow) ? Might need here!
    Range("A" & TopRow) = "WorkSheet: " & MyBom & "    Rows: " & CStr(MyfirstValue) & " to " & CStr(MyLastValue)
    Range("A" & CStr(TopRow)).Font.ColorIndex = 22
    If TopRow > 5 Then
        Range("B1") = "Multi-Rollup Sheet"
        Else
        Range("B1") = "Single-Rollup Sheet"
    End If
    Range("B" + CStr(TopRow)).Select
    'Don't forget to value quantity column
Cancel:
End Function

相关内容