修剪VBA中字典的内容

时间:2018-05-30 12:37:32

标签: excel vba excel-vba dictionary

我有一个Excel公式,可以在单元格中找到 Nth to last word 并输出它。但是,现在我使用VBA宏以更格式化的形式将错误排序的数据从Sheet1输出到Sheet2。

我现在要做的是在将数据复制到第二张之前修改我存储数据的数据结构的内容。在第二张表中我只想要具体的东西(比如第二/第三到最后一个单词或只有数字)。正在使用的数据结构是字典。

我知道在VBA中执行此操作的基本方法是:

Split(Sheets("reportsheet").Range("A1").Value, " ")(wordNumber - 1)

然而,我真的很遗憾如何在我的情况下应用这个。 VBA代码如下:

Sub findData()

    Dim datasheet As Worksheet
    Dim reportsheet As Worksheet

    Dim SearchString As String
    Dim i As Integer
    Dim j As Integer

    Set datasheet = Sheet1
    Set reportsheet = Sheet2

    Dim chNum As String 'Ticket number
    Dim chSub As String 'Change subject
    Dim rptNum As String 'analysis number
    Dim ChangeNumbers As New Dictionary 'dictionary that holds all of the info (ticket number, change subject, analysis number and details)

    Dim dictKey1 As Variant
    Dim dictKey2 As Variant
    Dim dictKey3 As Variant
    Dim dictKey4 As Variant

    Dim formula1 As String
    Dim formula2 As String

    reportsheet.Range("A1:H200").ClearContents
    finalrow1 = datasheet.Cells(datasheet.Rows.Count, 1).End(xlUp).Row

    'Loop that finds the required pieces of text from the data-sheet
    For i = 1 To finalrow1
        'Basic info in column A
        SearchString = datasheet.Range("A" & i)

        If InStr(1, SearchString, "Change number") Then
            chNum = datasheet.Cells(i, 1)

            ChangeNumbers.Add chNum, New Dictionary 'For ticket numbers
        ElseIf InStr(1, SearchString, "Change subject") Then
            chSub = datasheet.Cells(i, 1)
            ChangeNumbers.Item(chNum).Add chSub, New Dictionary 'For change subjects
        ElseIf InStr(1, SearchString, "Report-") Then
            rptNum = datasheet.Cells(i, 1)
            ChangeNumbers.Item(chNum).Item(chSub).Add rptNum, New Dictionary 'For analysis

            'Loop for the details (requirements, tech.specs, impl. and testing)
            j = 0
            'Verifies that the details belong to the current report
            'String checks are included after locating a report to maintain a connection between the report and its details
            Do While IsEmpty(datasheet.Cells(i + j, 1)) Or datasheet.Cells(i + j, 1) = rptNum
                If InStr(1, datasheet.Cells(i + j, 2), "Priority") Then
                    ' The 4 after ".Add" is the column number for this detail in sheet2
                    ChangeNumbers.Item(chNum).Item(chSub).Item(rptNum).Add 4, datasheet.Cells(i + j, 2) ' the detail #1
                ElseIf InStr(1, datasheet.Cells(i + j, 2), "Workload") Then
                    ' The 5 after ".Add" is the column number for this detail in sheet2
                    ChangeNumbers.Item(chNum).Item(chSub).Item(rptNum).Add 5, datasheet.Cells(i + j, 2) ' the detail #2
                ElseIf InStr(1, datasheet.Cells(i + j, 2), "Deadline") Then
                    ' The 6 after ".Add" is the column number for this detail in sheet2
                    ChangeNumbers.Item(chNum).Item(chSub).Item(rptNum).Add 6, datasheet.Cells(i + j, 2) ' the detail #3
                End If

                j = j + 1
            Loop
        End If
    Next i

    i = 1
    For Each dictKey1 In ChangeNumbers.Keys
        reportsheet.Cells(i, 1) = dictKey1 'Change Ticket Number

        If ChangeNumbers.Item(dictKey1).Count > 0 Then
            For Each dictKey2 In ChangeNumbers.Item(dictKey1).Keys
                reportsheet.Cells(i, 2) = dictKey2 'Change Subject; assuming in column B on same row as Change Number

                If ChangeNumbers.Item(dictKey1).Item(dictKey2).Count > 0 Then
                    For Each dictKey3 In ChangeNumbers.Item(dictKey1).Item(dictKey2).Keys 'Analysis number
                        reportsheet.Cells(i, 3) = dictKey3
                        'reportsheet.Cells(i, 2) = dictKey2 'Uncomment if you want change subject in every row w/ matching report

                        For Each dictKey4 In ChangeNumbers.Item(dictKey1).Item(dictKey2).Item(dictKey3).Keys
                            reportsheet.Cells(i, dictKey4) = ChangeNumbers.Item(dictKey1).Item(dictKey2).Item(dictKey3).Item(dictKey4)
                        Next dictKey4
                        i = i + 1 'moves to new row for new report (or next change number)
                    Next dictKey3
                Else
                    i = i + 1 'no reports, so moves down to prevent overwriting change number
                End If
            Next dictKey2
        Else
            i = i + 1 'no change subject, so moves down to prevent overwriting change number
        End If
    Next dictKey1


End Sub

我发现有关VBA功能的文档非常难以理解。我无法找到如何在实践中应用这个问题的答案。我把它存储在字典中后试图改变一切,但这似乎没有用。我所有的努力都导致了循环停止或错误。

有人可以给我一些关于从哪里开始的提示吗?

2 个答案:

答案 0 :(得分:0)

跟随你的代码/掌握你想要做的事情会有点麻烦。但我试着遵循:

此代码将通过工作表中的列表。对于该列表中的每个项目,程序将该项目拆分为“”并将内容放入数组中。然后我们找到该数组中有多少项。然后,我们将第二个到第二个项目(或从第三个到最后一个,第四个到最后一个等等,请参见可用变量,使用secondToLast进行旋转以进行更改)

lstFlowList.FlowTappedBackgroundColor = Color.White;
lstFlowList.FlowRowBackgroundColor = Color.White;

答案 1 :(得分:0)

有三种选择:

  1. 在将字符串存储到字典
  2. 之前拆分字符串
  3. 编辑字典内容
  4. 在从字典中提取字符串时拆分字符串
  5. 对于大多数代码,我认为使用选项1)会最有意义。主要是因为字典可能被多次使用。此外,此方法允许您要编辑的字符串作为键。

    根据字典结构,选项2)可能是最简单的,也可能是最复杂的。 (使用嵌套的词典 - 以及可能保存哪个词的不同规则 - 这可能会更复杂)。但是,如果你想使用这种方法,请注意你必须使用新方法覆盖旧项目(如果你要更改键值,你只需要添加键 - 而不是覆盖它们)

    如果您只是从字典中提取一次值,那么在使用之前编辑字符串可能是最简单的。

    我相信您的代码,您可能希望在将值存储在字典中之前进行编辑。

    我认为,主要是在您的代码的这一部分:

    For i = 1 To finalrow1
            'Basic info in column A
            SearchString = datasheet.Range("A" & i)
    
            If InStr(1, SearchString, "Change number") Then
                chNum = datasheet.Cells(i, 1)
    
                ChangeNumbers.Add chNum, New Dictionary 'For ticket numbers
            ElseIf InStr(1, SearchString, "Change subject") Then
                chSub = datasheet.Cells(i, 1)
                ChangeNumbers.Item(chNum).Add chSub, New Dictionary 'For change subjects
            ElseIf InStr(1, SearchString, "Report-") Then
                rptNum = datasheet.Cells(i, 1)
                ChangeNumbers.Item(chNum).Item(chSub).Add rptNum, New Dictionary 'For analysis
    
                'Loop for the details (requirements, tech.specs, impl. and testing)
                j = 0
                'Verifies that the details belong to the current report
                'String checks are included after locating a report to maintain a connection between the report and its details
                Do While IsEmpty(datasheet.Cells(i + j, 1)) Or datasheet.Cells(i + j, 1) = rptNum
                    If InStr(1, datasheet.Cells(i + j, 2), "Priority") Then
                        ' The 4 after ".Add" is the column number for this detail in sheet2
                        ChangeNumbers.Item(chNum).Item(chSub).Item(rptNum).Add 4, datasheet.Cells(i + j, 2) ' the detail #1
                    ElseIf InStr(1, datasheet.Cells(i + j, 2), "Workload") Then
                        ' The 5 after ".Add" is the column number for this detail in sheet2
                        ChangeNumbers.Item(chNum).Item(chSub).Item(rptNum).Add 5, datasheet.Cells(i + j, 2) ' the detail #2
                    ElseIf InStr(1, datasheet.Cells(i + j, 2), "Deadline") Then
                        ' The 6 after ".Add" is the column number for this detail in sheet2
                        ChangeNumbers.Item(chNum).Item(chSub).Item(rptNum).Add 6, datasheet.Cells(i + j, 2) ' the detail #3
                    End If
    
                    j = j + 1
                Loop
            End If
        Next i
    

    您提供的分割线示例:

    Split(Sheets("reportsheet").Range("A1").Value, " ")(wordNumber - 1)
    

    有一个wordNumber变量,我在现有代码中没有看到它;所以我现在假设它是一个伪(占位符)变量。

    我可能会尝试像这样添加分割:

    而不是

    chNum = datasheet.Cells(i, 1)
    

    添加拆分以使其成为

    chNum = Split(datasheet.Cells(i, 1)," ")(wordNumber - 1)
    

    而不是

    ChangeNumbers.Item(chNum).Item(chSub).Item(rptNum).Add 4, datasheet.Cells(i + j, 2) ' the detail #1
    

    添加拆分以使其成为

    ChangeNumbers.Item(chNum).Item(chSub).Item(rptNum).Add 4, Split(datasheet.Cells(i + j, 2)," ")(wordNumber - 1) ' the detail #1
    

    依此类推,通过其他适用的代码部分。

    请注意上面的第一个示例,如果您在此处添加了拆分:

    ChangeNumbers.Add chNum, New Dictionary 'For ticket numbers
    

    - >

    ChangeNumbers.Add Split(chNum," ")(wordNumber - 1), New Dictionary 'For ticket numbers
    

    我相信你会导致错误,例如:

    ChangeNumbers.Item(chNum).Item(chSub).Item(rptNum).Add 4, datasheet.Cells(i + j, 2) ' the detail #1
    

    将不再引用ChangeNumbers字典中的有效密钥(chNum将不再等于此处指定的密钥ChangeNumbers.Add Split(chNum," ")(wordNumber - 1), New Dictionary 'For ticket numbers(密钥 - > {{1} })