0

我想根据条件列出从 Sheet1 到 Sheet2 的行，一旦根据第一个条件没有要复制的行，就转到下一个条件，并按标题分隔复制的行。

Sheet1 包含一个未排序的项目列表，我希望能够随时添加和删除项目。我还想将项目分类为不同的类型。Sheet1 看起来像这样：

ProjectID 项目名称 类型 成本
1个项目A发展-120
2 项目B开发-250
3 ProjectC维护-30

然后我想通过 VBA 将数据复制到 Sheet2 中，格式如下：

维护项目
ProjectID 项目名称 类型 成本
3 ProjectC维护-30

开发项目
ProjectID 项目名称 类型 成本
1个项目A发展-120
2 项目B开发-250

我一直在寻找解决方案，但没有找到适合我需要的解决方案，而且我不是一个非常有经验的 VBA 用户。关于在这里使用什么方法的任何提示或提示？

4

1 回答 1

0

假设 sheet2 在您请求的格式中为空白，这会将您的数据从 sheet1 复制到 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-05T20:38:45.143 回答