Обрезка содержимого словаря в VBA

Question

У меня есть формула Excel, которая находит с N-го по последнее слово в ячейке и выводит его.Однако теперь я использую макрос VBA для вывода плохо упорядоченных данных из Sheet1 в Sheet2 в более отформатированном виде.

Сейчас я пытаюсь изменить содержимое структуры данных, в которой хранятся данные.прежде чем он будет скопирован на 2-й лист.На 2-м листе я хотел бы иметь только определенные вещи (например, 2-е / 3-е до последнего слова или только цифры).Используемая структура данных - это словарь.

Я знаю, что базовый способ сделать это в 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 чрезвычайно трудна для понимания.Я не мог найти ответ о том, как применить это на практике.Я пытался изменить все после того, как он был сохранен в словаре, но это не сработало.Все мои усилия привели к остановке цикла или ошибкам.

Кто-то может дать мне советы, с чего начать?

Answer 1

Существует три варианта:

1. Разделить строку перед сохранением в словаре
2. Редактировать содержимое словаря
3. Разделить строки по мере их извлеченияиз словаря

Для большей части кода я бы полагал, что использование варианта 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 (ключ -> Split(chNum," ")(wordNumber - 1))