我为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
答案 0 :(得分:0)
Sub Color()
Dim myRange As Range
Set myRange = Range("B1")
myRange.Interior.ColorIndex = 22
End Sub