Question

从事工作项目，我被困住了。我已经有了一个在活动单元格上添加新行的函数。

现在我想将灰色颜色添加到新行，当新行单元格中包含字母或数字时，它将显示为无颜色（hvite）。 SEE IMAGE OF PROJECT HERE 此外，我不希望颜色比列S更长，如图中所示。

我不是此代码的作者。而且我甚至都不理解。代码如下。此代码中可能存在某些类型的错误，无法将其从计算机写入另一个计算机。下面的代码工作。只需要将颜色添加到行

`Sub insert_row()
  Dim LineNumber As Integer
  Dim insertionpoint
  Dim Rownumber, Positionrow As Integer
  Dim MarkedArea As String

 Application.ScreenUpdating = False 'Stops screenupdating
 Insertionpoint = ActiveCell.Address
 LineNumber = ActiveCell.Row

 For Rownumber = 5 To 1000
     If Range("B" & Rownumber).Value = "PLACE" Then
     Positionrow = Rownumber + 1
     End If
 Next Rownumber
 If LineNumber < Positionrow - 5 And LineNumber > 6 Then
     Range(Insertionpoint).Select
     Selection.EntireRow.Insert 'Inserts new row over active cell
     LineNumber = ActiveCell.Row
     Range("A" & LineNumber).Select
     ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",TEXT(RC[1],""DDMM"")&""0""&RC[2])"
     'More cell properties .....
     'More .....
     'More .....
      MarkedArea = "B" & LineNumber & ":X" & LineNumber
      Range("B" & LineNumber).Select

      'SetStandardFormat
      Range("AB6:AS6).Select ' not shown in picture
      Selection.Copy
      Range(Insertionpoint).Select
      Selection.PasteSpecial Paste:=x1PasteFormats, Operation:=x1None, _
           SkipBlanks:=False, Transpose:=False

 Else
      MsgBox ("Row can not be added here")
 End If
 Application.ScreenUpdating = False

 End Sub`

此外还有一个按钮

Private Sub CommandButton2_Click()
'add row
Insert_row
End Sub

希望得到一些帮助！谢谢。

Answer 1

您只想在添加的行中使用灰色？

Insertionpoint = ActiveCell.Address
Range(Insertionpoint).Select
Selection.EntireRow.Insert
With Range(Insertionpoint).EntireRow.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.249977111117893
    .PatternTintAndShade = 0
End With

给我以前测试的内容...没有修复任何.select，并从你的代码中提取出我需要测试的内容。

修改

为循环添加一些代码以添加颜色...将假设日期在B列中：

Dim i As Long, LR As Long LR = Cells(Rows.Count, "A").End(xlUp).Row 'assumes column A is contiguous For i = 2 To LR 'Assumes row 1 is headers If Cells(i, "B").Value = "" Then With Rows(i).EntireRow.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With Else Rows(i).EntireRow.Interior.Color = xlNone End If Next i

如果单元格是emty，则添加新行并给出颜色

1 个答案: