将按滤色的行按颜色复制到新工作表

Question

我有一个Excel电子表格，如下所示：

|      | Job1 | Job2 | Job3 | Job4 | Job5 |
| Job1 |      |      |      |      |      |
| Job2 |      |      |      |      |      |
| Job3 |      |      |      |      |      |
| Job4 |      |      |      |      |      |
| Job5 |      |      |      |      |      |

每行和每列之间的单元格是不同的颜色。我需要用橙色对每列进行排序，然后将行名称复制到新的表格中。

所以最后我会有一张这样的表：

| Job1 | Job2 |
| Job1 | Job4 |
| Job1 | Job5 |
| Job2 | Job3 |
| Job2 | Job5 |

这个想法是，如果你可以做Job1，你应该有权访问Job2。这是由第一张纸的列和行之间的交点决定的。尝试使用显示名称而不是颜色的工作表。总共有83个工作，因此手动执行此操作会让我复制超过4000个。

有没有人知道如何通过一次一列的颜色创建一个自动过滤的宏，并将列A1中的行的内容复制到一个新的表？

Answer 1

我试图从您的描述和样本数据/结果中了解实际数据。这就是我想出来的。

将其作为活动工作表，我运行了这个宏。

Sub organize_by_color()
    Dim rws As Long, c As Long, iCLR As Long, ws As Worksheet, wsT As Worksheet

    Set ws = ActiveSheet
    Set wsT = Worksheets.Add(after:=Sheets(Sheets.Count))

    iCLR = 49407 'Orange e.g. RGB(255, 192, 0)
    wsT.Cells(1, 1).Resize(1, 2) = Array("Job A", "Job B")

    With ws.Cells(1, 1).CurrentRegion
        .AutoFilter
        For c = 2 To .Columns.Count
            .AutoFilter Field:=c, Criteria1:=iCLR, Operator:=xlFilterCellColor
            With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
                rws = Application.Subtotal(103, .Columns(1))
                If CBool(rws) Then
                    .Columns(1).Copy Destination:=wsT.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
                    wsT.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(rws, 1) = ws.Cells(1, c).Value
                End If
            End With
            .AutoFilter Field:=c
        Next c
        .AutoFilter
    End With

    Set ws = Nothing
    Set wsT = Nothing

End Sub

这在工作表集合的末尾创建了一个新的工作表，其结果如下。

在我看来，在原始数据中使用E：F列没有太大意义，因为通过前三列已经发现了相反的关系，但我认为数据编辑可能会占冗余。或者我的假设完全错误，因为没有注意到数据样本中矩阵中的哪些单元实际上包含橙色回填。也许你可以为自己的目的转录这个。如果您遇到困难，请回复问题和具体细节。

Answer 2

我最终创建了一个Web界面并将所有内容转换为SQL数据库。所以SQL数据库和逻辑可以完成所有这些，而不是试图将excel放在类固醇上。