宏适用于VBAProject Sheet 1,但不适用于VBAProject Personal

时间:2017-09-03 10:20:08

标签: excel-vba vba excel

我有一个我用一点点辅助构建的宏,它就像我想要的那样工作。问题是现在我每次都要复制并粘贴代码才能使用它。我尝试将其转移到VBAProject(个人),当我运行它时,我收到一个基于代码的一部分的错误。我需要帮助弄清楚如何将其设置为personal.xlsb,这样我就可以每天使用它而无需将其保存到我每天工作的书中。我收到的错误是Run-time error '9' subscript out of range。再次,当我从工作簿中将其移至个人时,我只会收到该错误,并且我不熟悉excel,因此我的大部分宏被重新排序

Sub AutoAdjust()
'
' AutoAdjust Macro
'
' Keyboard Shortcut: Ctrl+m
'
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cel As Range


    Columns("C:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:N").Select
    Selection.Delete Shift:=xlToLeft
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Days Delinquent"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Remarks"
    Columns("O:O").Select
    Columns("N:N").EntireColumn.AutoFit
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("J:J").Select
    Selection.TextToColumns Destination:=Range("J1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(11, 1)), TrailingMinusNumbers:=True
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Created Date"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=ABS(TODAY()-RC[-4])"
    Range("N2").Select
    Selection.AutoFill Destination:=Range("N2:N107")
    Range("N2:N107" & lastRow).Select
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("-").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("-").AutoFilter.Sort.SortFields.Add Key:=Range("J1" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("-").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With      

    Set ws = ThisWorkbook.Sheets("-")  'change Sheet2 to your data sheet
    With ws
        lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row  'last row in Column N
        For Each cel In .Range("N2:N" & lastRow)    'loop through all values in Column N
            If cel.Value <= 3 Then                  'if cell value is less than or equal to 3
                cel.EntireRow.Interior.Color = vbGreen  'color entire row with green color
            ElseIf cel.Value = 4 Or cel.Value = 5 Then  'if cell value is equal to 4 or 5
                cel.EntireRow.Interior.Color = vbYellow 'color entire row with green yellow
            Else                                        'any othe cell value i.e. cell value greater then 5
                cel.EntireRow.Interior.Color = vbRed    'color entire row with green red
            End If
        Next cel
    End With
End Sub

1 个答案:

答案 0 :(得分:0)

我发现了我的问题。

let object = "workstation"

需要

Set ws = ThisWorkbook.sheets("-")