Excel VBA仅在中断模式下执行突出显示单元格

时间:2015-12-11 16:32:18

标签: excel vba excel-vba

我为ExcelVBA编写了一个非常简单的宏。它基本上复制了工作表的整个部分,然后将4添加到用户选择的单元格中。

我的挑战是结束 - 我想强调我添加4的单元格。 我选择了单元格并粘贴了值:

With Progression.Cells(CatSearch, CurrentColumn)
    .Value = LF
    .Interior.ColorIndex = 37
End With

问题是它会改变单元格的值,而不是颜色。

有趣的是,它在中断模式下工作,但在运行整个宏时却不行。

Public Sub BuildFootageProgression()

Dim Category As Byte
Dim Working As Workbook
Dim Progression As Worksheet

Set Working = ActiveWorkbook
Set Progression = Working.Sheets(1)


Category = InputBox("Enter Category Number of Category to Gain Next Four Feet", "Category Decision Box")
''Asks which category should gain the next four feet in a popup box


Dim CatSearch As Integer
Dim InputResult As String
CatSearch = 1


'Start by verifying that the input category is in the list, and identifies the row # of that category and saves to variable "Cat Search"

Do Until Sheet1.Cells(CatSearch, 1).Value = Category
    CatSearch = CatSearch + 1

    If CatSearch > 10000 Then
        InputResult = InputBox("The previously entered category number could not be found. Enter Category Number of Category to Gain Next Four Feet.", "Category Decision Box")

        If InputResult = vbNullString Then
            Exit Sub
        Else
            Category = InputResult
            CatSearch = 1
        End If
    End If
Loop


'This section is to find the first blank column and identify the 12 columns we will be working with
If Sheet1.Cells(CatSearch, 1).Value = Category Then

    Dim CurrentColumn As Integer
        CurrentColumn = 1

    Do Until IsEmpty(Cells(1, CurrentColumn))
    CurrentColumn = CurrentColumn + 1
    Loop


End If

'Function to copy formula from previous section to current section
Dim previous As Range
Set previous = Range(Sheet1.Cells(1, CurrentColumn - 11), Sheet1.Cells(100, CurrentColumn - 1))
previous.Copy (Sheet1.Cells(1, CurrentColumn))

Dim Current As Range
Set Current = Range(Sheet1.Cells(1, CurrentColumn + 1), Sheet1.Cells(100, CurrentColumn + 10))
Current.Columns.AutoFit

'Unhighlights all of the cells
For Each c In Current.Cells
    c.Interior.ColorIndex = 2
Next

'Adds four feet to chosen category
Dim LF As Integer
LF = Sheet1.Cells(CatSearch, CurrentColumn).Value
LF = LF + 4

With Progression.Cells(CatSearch, CurrentColumn)
    .Value = LF
    .Interior.ColorIndex = 37
End With


'Takes Null Values and Makes the Cells Blank
Cells.Replace "#N/A", "", xlWhole

End Sub

1 个答案:

答案 0 :(得分:0)

Sub Color()
  Dim myRange As Range
  Set myRange = Range("B1")
  myRange.Interior.ColorIndex = 22
End Sub