vba - 如何识别有助于作为小计的颜色格式单元格的行范围，并应用于多个列？

Question

我真的是 VBA 代码的新手，并试图改进以变得更好。如果有人可以在我的代码中进一步帮助我，需要帮助。提前感谢您的耐心等待。

我想要实现的是通过具有多行和多列的表运行代码，以将选定范围复制到同一工作簿的另一个工作表中。我正在尝试确定哪些单元格具有颜色格式(例如 H2)。一旦确定，我想返回同一行的第一列(在本例中，它将是 A2)​​。然后从那里运行该列的代码以查看重复的名称(A 列是名称)。一旦检测到不同的名称来源，我想将找到的第一个名称的范围(在本例中为 A2)复制到跨多个列(A 列到 newlastcol)的姓氏(例如 A6)。 A7被发现是一个不同的名字。

表格中的 A 列数据已经从 A 到 Z 排序，颜色格式的单元格是为相同名称计算的小计，并且始终显示在顶部。它的行号将始终是在 A 列中找到的第一个名称。

    Dim StartTest As Range, StartName As Range
    Dim lastrow As Integer, lastcol As Integer
    Dim R As Integer, C As Integer
    Dim i As Long, j As Long, k As Long

  'Filter off Coloured Cells
    Set StartTest = Cells(1, 1)
    StartTest.Select

   Do Until IsEmpty(ActiveCell)
       newlastrow = ActiveCell.Row
       ActiveCell.Offset(1, 0).Select
   Loop

    StartTest.Select
   Do Until IsEmpty(ActiveCell)
       newlastcol = lastcol + 1
       ActiveCell.Offset(0, 1).Select
   Loop

   NextColumn:
    C = StartTest(1).Column
    R = StartTest(1).Row

    Set filterrng = Range(Cells(R, C), Cells(newlastrow, C))

    Cells(1, C).Select
        If IsEmpty(ActiveCell) = True Then
    GoTo NextPart
        End If

    For j = 2 To newlastrow

        Cells(j, C).Select
            If Cells(j, C).Interior.Color = 255 Then
                Cells(j, 1).Select

                **'Problem Line**
                Set StartName = Cells(j, 1)
                NameC = StartName(1).Column
                NameR = StartName(j).Row

                StartName.Select
                For k = NameR To newlastrow
                If Cells(NameR, NameC) <> Cells(NameR + 1, NameC) Then
                    namelastrow = k
                    Range(Cells(NameR, NameC), Cells(namelastrow, newlastcol)).Select
                    Selection.Copy
                End If
                Set StartName = StartName.Offset(1, 0)
                Next k
             End If

           Next j
            Cells(R, C + 1).Select

            Set filterrng = filterrng.Offset(0, 1)
            Set StartTest = StartTest.Offset(0, 1)

            GoTo NextColumn

    End Sub

我可以让代码在多列中运行，并且可以将光标放回同一列(A2)行的单元格。但是我在“开始日期部分”中遇到了问题，这是检查同一列或多行中重复名称并突出显示要复制到另一张表中的范围的部分。

提前感谢大家的反馈。如果有其他建议或建议，真的很感激。

Answer 1

直到 StrComp(ActiveCell.Value, ActiveCell.Offset(1, 0).Value) = True 或 IsEmpty(ActiveCell.Value)

            ActiveCell.Resize(1, 5).Copy

                ActiveCell.Offset(1, 0).Select

                Sheets("C").Activate

                ActiveCell.PasteSpecial

                ActiveCell.Offset(1, 0).Select

        Sheets("AB").Activate



    Loop

万一

Range("g3").Select

    If ActiveCell.Interior.Color = RGB(255, 255, 0) Then

        Range("a1:a30").Find(what:="yelow").Activate




    Do Until StrComp(ActiveCell.Value, "yelow") = True Or IsEmpty(ActiveCell.Value)

            ActiveCell.Resize(1, 5).Copy

                ActiveCell.Offset(1, 0).Select

                Sheets("C").Activate

                ActiveCell.PasteSpecial

                ActiveCell.Offset(1, 0).Select

        Sheets("AB").Activate


    Loop

    End If


Loop

ActiveCell.Offset(1, 0).Select