VBA：如何列出由標題分隔的行上的項目？

我希望根據條件列出Sheet1到Sheet2中的行，一旦沒有更多的行根據第一條件進行復制並按照標題分隔複製的行，則繼續下一條標準。VBA：如何列出由標題分隔的行上的項目？

Sheet1包含未排序的項目列表，我希望能夠隨時添加和刪除項目。我也想把項目分成不同的類型。工作表Sheet1是這樣的：

 
ProjectID  ProjectName Type   Cost 
1    ProjectA  Development -120 
2    ProjectB  Development -250 
3    ProjectC  Maintenance  -30

然後，我會想通過VBA中的數據複製到Sheet2中的格式如下：

 
Maintenance Projects 
ProjectID  ProjectName Type   Cost 
3    ProjectC  Maintenance  -30 

Development Projects 
ProjectID  ProjectName Type   Cost 
1    ProjectA  Development -120 
2    ProjectB  Development -250

我一直在試圖尋找一個解決方案，但避風港」發現一個適合我的需求，我不是一個非常有經驗的VBA用戶。任何提示或提示在這裏使用什麼方法？

來源

2013-03-05 Galladin

您是否要求工作表2和工作表3與工作表1完全相同？如果不是，一個簡單的方法來完成這將是使用數據透視表。數據透視表可以讓你輕鬆地「自動刷新」，對列進行重新排序，創建總和/等等。但是，透視表會比原始數據有一點點不同。 – GTG 2013-03-05 16:44:59

這會將您的數據從sheet1複製到sheet2，假設sheet2在您請求的格式中爲空白。

Sub SplitData_Click() 
    Dim dicType As Object 
    Set dicType = CreateObject("scripting.dictionary") 

    Dim i As Integer 
    Dim lstRow As Long 
    Dim val As String 
    lstRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Row 

    Dim projects() As Variant 
    ReDim projects(0 To lstRow - 2, 0 To 3) ' I like 0 based arrays 

    ' Populate the dictionary with the unique types 
    For i = 2 To lstRow 
     projects(i - 2, 0) = Range("A" & i) ' ProjectID 
     projects(i - 2, 1) = Range("B" & i) ' ProjectName 
     projects(i - 2, 2) = Range("C" & i) ' Type 
     projects(i - 2, 3) = Range("D" & i) ' Cost 

     val = Range("C" & i) 
     If dicType.Exists(val) Then 
      dicType.Item(val) = dicType.Item(val) + 1 
     Else 
      dicType.Add val, 1 
     End If 
    Next i 

    Dim header() As Variant 
    ReDim header(0 To 3) 
    header(0) = "ProjectId" 
    header(1) = "ProjectName" 
    header(2) = "Type" 
    header(3) = "Cost" 

    Sheets("Sheet2").Select 

    ' loop through each type and build its structure on sheet 2 
    Dim key As Variant 
    For Each key In dicType 
     If Range("A1") = "" Then 
      Range("A1").Value = key & " Projects" 
     Else 
      lstRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row + 2 
      Range("A" & lstRow).Value = key & " Projects" 
     End If 

     lstRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row + 1 
     Range("A" & lstRow).Value = header(0) 
     Range("B" & lstRow).Value = header(1) 
     Range("C" & lstRow).Value = header(2) 
     Range("D" & lstRow).Value = header(3) 

     For i = 0 To UBound(projects) 
      lstRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row + 1 
      If projects(i, 2) = key Then 
       Range("A" & lstRow).Value = projects(i, 0) 
       Range("B" & lstRow).Value = projects(i, 1) 
       Range("C" & lstRow).Value = projects(i, 2) 
       Range("D" & lstRow).Value = projects(i, 3) 
      End If 
     Next i 

     Debug.Print key 
    Next key 
End Sub

來源

2013-03-05 20:38:45 Zaider

VBA：如何列出由標題分隔的行上的項目？

回答

相關問題