Question

所以我在VBA中有一个宏，它从“输入”表中获取数据并填充“当前”表。一切都必须是校准9并且J-M列必须全部为绿色，但是J-M列的第133行既不是绿色也不是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

Answer 1

您需要将这些单元格设置为您希望它们的格式，手动（将数据粘贴到它们中，不会覆盖格式）或通过以下代码：

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

行不会更改VBA中的颜色

1 个答案: