Mã lỗi VBA trong năm 2010 vượt trội

Tìm kiếm một số trợ giúp trong việc gỡ lỗi một số mã VBA / Macro cũ để hoạt động trong phiên bản mới hơn của MS Excel 2010.

Mục đích của macro là sau khi chọn một phạm vi ô liền kề trong một cột nhất định. Sau đó, macro sẽ sao chép phạm vi thông tin tương ứng (B ?: H?) Sang một trang tính mới hoặc trang tính hiện có, sắp xếp thông tin theo các giá trị trong cột "Phần #" (D).

Cho đến thời điểm này, macro hoạt động như dự định. Nhưng nó lỗi và khi nó cố gắng kết hợp các mục với "phần #" tương tự và xóa các mục trùng lặp. Bất kỳ trợ giúp hoặc hỗ trợ bạn có thể gửi theo cách của tôi sẽ được đánh giá rất cao.

Việc tin rằng các lỗi / lỗi bắt đầu trên dòng sau "Rollup, Like Number Number, Combine Quantality and Delete Rows".

Dưới đây là mã VBA đã trở thành nguyên nhân của sự tồn tại của tôi.

'**************************  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

Cám ơn cho những giúp đỡ mà bạn có thể làm.

— xenologic
nguồn

Như vậy, đây là loại "Đây là một số mã, hãy sửa nó cho tôi" ..: / Lỗi thực sự bạn gặp phải là gì? Khi bạn gỡ lỗi và bước qua nó, lỗi chính xác được ném ở đâu? Những gì bạn đã cố gắng cho đến nay trong nỗ lực để làm cho nó hoạt động?

— Ƭᴇcʜιᴇ007

Vui lòng cung cấp thông báo lỗi bạn nhận được và dòng nào đang ném lỗi.

— Excellll

Xin lỗi, lỗi là "Lỗi thời gian chạy '13 '" không khớp.

— xenologic

Xin lỗi, lỗi là "Lỗi thời gian chạy '13 '" không khớp. Tôi ban đầu nghĩ rằng đó là một lỗi cú pháp đơn giản sau khi thực hiện một số nghiên cứu trực tuyến. Tôi đã thử thay đổi dấu cộng "+" tuyên bố phạm vi thành "& amp;". làm điều này sẽ cho phép macro hoàn thành nhưng đầu ra thậm chí không gần với việc xuất giá trị hoặc phản hồi chính xác. Lỗi xảy ra trên dòng mã sau đây. "Đối với mỗi c1 trong trang tính (MyRollup) .Range (" D "& amp; TopRow +": D "& amp; NewLastRow)"

— xenologic

Ảnh chụp màn hình đầu ra lỗi của bạn. Cũng sẽ giúp xem các bảng excel của bạn để có hình ảnh rõ ràng nếu có thể tải lên chúng quá.

— ejbytes

Câu trả lời:

Đó là '+' Là sai rồi.

Bạn chuỗi nối với & và thêm số với +.

Giả sử TopRow = 1 và NewLastRow = 5:

Bạn đang cố gắng THÊM "D1" thành ": D5" và vì bạn không thể thực hiện các phép toán bổ sung trên chuỗi, bạn sẽ gặp lỗi không khớp khi nhập.

Ngoài ra - các vấn đề giá trị đầu ra không có lỗi cú pháp là các vấn đề logic, để giải quyết vấn đề đó, chúng tôi sẽ cần thông tin cụ thể khác. Vì vậy, những câu hỏi đó có thể được xử lý tốt nhất dưới dạng câu hỏi mới (với thông tin phù hợp được cung cấp) để chúng tôi có thể giải quyết các vấn đề bạn gặp phải một lúc, sau khi bạn chia sẻ điều tra về chúng. :)

— Ƭᴇcʜιᴇ007
nguồn

tôi đã thay đổi '+' sybmol thành '& amp;' và nó tiến triển hơn nữa trong chuỗi mã cho đến khi nó gặp phải các lỗi cú pháp tương tự. tôi đã sửa những lỗi này Như tôi đã đề cập trước đó, không có gì chính xác cả.

— xenologic

dưới đây là thông tin mà macro đang cố gắng hợp nhất. Mục Mô tả Mfg Phần # Số lượng C C C 2 A A A 1 A A A 1 B B B 3 B B B 3 C C C 2

— xenologic

đây là đầu ra macro: Mục Mô tả Mục Mfg Phần # Số lượng B B B 5 C C C 5 C C C 2

— xenologic

Vâng, một câu hỏi cho mỗi câu hỏi. ;) Nếu bạn có một câu hỏi mới, hãy đăng nó dưới dạng một câu hỏi mới.

— Ƭᴇcʜιᴇ007

tốt, trong VBA nếu bạn chỉ ghép nối Strings sử dụng +. Bạn không thể làm String + Integer nhưng nó tốt cho String + String + String

 
1. I noticed a mixture of &'s and +'s.
   1a. I fixed them.

2. I think you need to  bỏ số nguyên của bạn  đến chuỗi (TopRow, NewLastRow, các chuỗi khác).
   2a. Tôi đúc chúng cho bạn.

Tôi cắt mã của bạn chính xác.

Tôi đã thêm một số ý kiến rằng bạn sẽ   nhìn thấy màu xanh lá cây khi bạn cắt nó và dán nó.

Tôi đã thêm casting   để số nguyên của bạn trong các trường Phạm vi.

Nếu mã của bạn là chính xác   bây giờ sẽ làm việc Nếu nó vẫn là Err thì bạn phải xem xét một số logic.   Sử dụng một số gỡ lỗi để nhắn tin cho mình, ví dụ: MsgBox "dùng thử mã   var: "& amp; 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

— ejbytes
nguồn