行不会更改VBA中的颜色
所以我有一个VBA中的macros，它从“input”工作表获取数据并填充“当前”工作表。 一切都必须是校准9和列JM必须是绿色的，但行133列JM既不是绿色，也不是大小9.我想知道我能做些什么来解决这个问题。
这是目前我有的代码
Sub Load16() Application.ScreenUpdating = False 'Define Workbooks Dim loopCount As Integer Dim loopEnd As Integer Dim writeCol As Integer Dim matchRow As Integer Dim writeRow As Integer Dim writeEnd As Integer loopEnd = WorksheetFunction.CountA(Worksheets("Input").Range("A:A")) writeEnd = WorksheetFunction.CountIf(Worksheets("Input").Range("L:L"), "-1") loopCount = 1 writeRow = 1 Worksheets("Buttons").Range("F17:I17").Copy Worksheets("Current").Range("J2:M" & writeEnd).PasteSpecial Paste:=xlPasteAll Application.CutCopyMode = False Do While loopCount <= loopEnd If Worksheets("Input").Cells(loopCount, 12).Value <> "" And Worksheets("Input").Cells(loopCount, 12).Value <> 0 Then Worksheets("Current").Cells(writeRow, 1).Value = Worksheets("Input").Cells(loopCount, 26).Value writeCol = 2 Do While writeCol <= 9 Worksheets("Current").Cells(writeRow, writeCol).Value = Worksheets("Input").Cells(loopCount, writeCol - 1) writeCol = writeCol + 1 Loop writeCol = 14 Do While writeCol <= 30 Worksheets("Current").Cells(writeRow, writeCol).Value = Worksheets("Input").Cells(loopCount, writeCol - 5) writeCol = writeCol + 1 Loop Worksheets("Current").Cells(writeRow, 31).Value = Worksheets("Input").Cells(loopCount, 27) writeRow = writeRow + 1 Else End If loopCount = loopCount + 1 Loop Worksheets("Current").Range("J1").Value = "Counsel" Worksheets("Current").Range("K1").Value = "Background" Worksheets("Current").Range("L1").Value = "Comments" Worksheets("Current").Range("M1").Value = "BM Action" Lookup Data for K - M and a few other things loopCount = 2 Do While loopCount <= loopEnd matchRow = 0 On Error Resume Next matchRow = WorksheetFunction.Match(Worksheets("Current").Cells(loopCount, 1).Value, _ Worksheets("Old").Range("A:A"), 0) If matchRow = 0 Then Else Worksheets("Current").Cells(loopCount, 11).Value = Worksheets("Old").Cells(matchRow, 11).Value Worksheets("Current").Cells(loopCount, 12).Value = Worksheets("Old").Cells(matchRow, 12).Value Worksheets("Current").Cells(loopCount, 13).Value = Worksheets("Old").Cells(matchRow, 13).Value End If Worksheets("Current").Cells(loopCount, 10).Value = Worksheets("Current").Cells(loopCount, 18).Value loopCount = loopCount + 1 Loop Sheets("Current").Range("A2:AE" & loopEnd).Sort Key1:=Sheets("Current").Range("H2"), _ Order1:=xlAscending, Header:=xlNo Worksheets("Current").Columns("A:BZ").AutoFit Application.ScreenUpdating = True Worksheets("Buttons").Select MsgBox loopEnd - 1 & " Rows processed. " & writeEnd & " Rows remain." End Sub 您需要将这些单元格设置为您希望的格式，或者手动（将数据粘贴到它们中不会覆盖格式）或通过如下所示的代码：
Range("J133:M133").Select With Selection.Font .Name = "Calibri" .Size = 9 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With