Excel VBA，复制彩色行答案

【问题标题】：Excel VBA, Copying Colored RowsExcel VBA，复制彩色行
【发布时间】：2018-10-15 23:24:32
【问题描述】：

我在“Sheet1”中有一个包含三列的列表，A（帐号）、B（描述）和 C（金额）。基于第一两列 (A & B) 颜色，我想将特定行复制到“Sheet2”并将其粘贴到一个特定标题下（我有三个标题）。

例子

Sheet1 - 单元格 A2 为“红色”，B2 为“黄色”，在 Sheet2 中的标题“效率低下”下复制/粘贴
Sheet1 - 单元格 A3 为“蓝色”，B3 为“无颜色”复制/粘贴在 Sheet2 中的标题“有效”下

Account Number  Description  Amount
LP001022        Graduate     3,076.00 
LP001031        Graduate     5,000.00 
LP001035        Graduate     2,340.00

我已经从这个站点获取了一个代码，但我无法完全按照我的需要配置它。提前感谢您的帮助。

Sub lastrow()
    Dim lastrow As Long
    Dim i As Long, j As Long
    Dim acell As Range

    With Worksheets("Sheet1")
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    MsgBox (lastrow)

    With Worksheets("Sheet3")
        j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With

    For i = 1 To lastrow
        With Worksheets("Sheet1")
            If .Cells(i, 1).Interior.Color = RGB(255, 255, 0) And _
               .Cells(i, 1).Interior.ColorIndex = xlNone Then
                   .Rows(i).Copy 'I have to give destination 
                   j = j + 1
                End If
        End With
    Next i
End Sub

【问题讨论】：

您的描述不清楚： 1.您不能在“标题”（列）下复制整行 - 您可以在标题处复制开始的行。 2. Sheet2 中的标题在哪里（“效率低下”和“有效”列是哪一列） 3. 你想在那里复制什么值？ 4.在你的代码中：一个单元格不能同时有2种颜色（.Cells(i, 1)）
你的If 条件永远不会成立。一个单元格不能同时是黄色 (.Color = RGB(255, 255, 0)) 和非彩色 (.ColorIndex = xlNone)

标签： vba excel

【解决方案1】：

以下是将行从 sheet1 复制到 INSERT 到 sheet2 中的行的关键说明。这假设您拥有所有行号。

' -- to copy a row in sh1 to INSERT into sh2:
  sh2.Rows(irowInefficiency + 1).Insert
  sh1.Rows(irowFrom).Copy sh2.Rows(irowInefficiency + 1)
' -- you have to increment all header rows after this one
  irowEffective = irowEffective + 1

以下将这些放在上下文中：

Sub sub1() ' copy/insert a row
  Dim irowFrom&, irowInefficiency&, irowEffective&
  Dim sh1, sh2 As Worksheet
  Set sh1 = Sheets("sheet1")
  Set sh2 = Sheets("sheet2")
  irowInefficiency = 3 ' where that header is
  irowEffective = 6 ' where that header is
  irowFrom = 5 ' the row to copy
' -- to copy a row in sh1 to INSERT into sh2:
  sh2.Rows(irowInefficiency + 1).Insert ' a blank row
  sh1.Rows(irowFrom).Copy sh2.Rows(irowInefficiency + 1) ' then copy
' -- you have to increment all header rows after this one
  irowEffective = irowEffective + 1 ' because it increases
End Sub

【讨论】：