複製過濾的行中的顏色，以新的工作表

Question

我有一個Excel電子表格，看起來是這樣的：

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

每行和每列之間的細胞是不同的顏色。我需要按橙色對每列進行排序，然後將行名稱複製到新工作表。

所以在最後我會像這樣的表：

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

的想法是，如果你能做到崗位1，你應該有機會獲得作業2。這由第一張紙張的行和列之間的交點決定。嘗試使用顯示名稱而不是顏色的表單。總共有83個工作，所以手動這樣做會讓我複製超過4000.

有誰知道如何創建一個宏按顏色自動篩選一列，並將列A1中的行的內容複製到新表？

Answer 1

我最終創建了一個Web界面並將所有內容轉換爲SQL數據庫。因此，SQL數據庫和邏輯可以完成所有這些工作，而不是試圖把類似的東西放在excel上。

Answer 2

我試圖對您的描述和樣本數據/結果中的實際數據有所瞭解。這是我想出的。

懷着這樣的活動工作表，我跑了這個宏。

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 

這在工作表集合的末尾創建了一個新的工作表，其結果如下。

在我看來，沒有在其列ë多點：在原有數據F任何關係指出也就已經被其反向發現通過前三列，但我猜想數據編輯可能會考慮冗餘。或者我的假設可能完全錯誤，因爲未注意到數據樣本中矩陣中的哪些單元格實際上包含橙色回填。也許你將能夠爲了你自己的目的而轉錄它。如果遇到困難，請回復問題和具體內容。