Использование VBA для поиска указанного c имени заголовка и группирование данных этих заголовков в несколько столбцов переименования - PullRequest
2 голосов
/ 26 февраля 2020

В большом файле, который я получаю пунктуально, я ищу реорганизацию данных в новом листе файла Excel.

Поэтому я ищу определенные c имена заголовков и переименовываю их и копирую данные или выполняю более сложные операции.

В более простом случае я переименовываю только столбцы. Я ищу столбец с именем «Spe c A» и переименовываю его в «Nabou»

. В более сложном случае я создаю новый столбец путем объединения столбцов. Однако, основываясь на том, присутствует ли информация в других столбцах или нет, я добавляю специальный текст c, который может изменяться в различных случаях. Например, я объединяю несколько столбцов «nup», «nap» и добавляю «WAGA» для строк со значениями, расположенными ниже некоторых указанных c заголовков, и добавляю «CIOCOLATO» для строк без значений, находящихся в этих же заголовки.

Два возможных результата:

  • nup_nap_WAGA_Snip (для случаев, когда заданные * строки 1060 * имеют значения ниже)

  • nup_nap_CIOCOLATO_Snip (для случаев, когда строки ниже указанных строк c не имеют значений)

В худшем случае в этом же файле я создаю новые столбцы, объединяя эти столбцы , но я также добавляю указанный c номер в некоторых случаях.
Чтобы узнать число, которое я увеличиваю, мне нужно посмотреть другой exel-файл (другой лист), чтобы добавить указанный c вход в приращении, которое должно быть приращением на основе указанного c условия.

Например, у меня был бы такой результат. «003» основан на проверке другой рабочей книги, которая будет искать строки ниже указанного c заголовка для термина «салат» и добавлять «003», когда после «салат» будет найдено «002»:

Lettuce003_SDS_FSGTEGT Cake0049_SDEWF_TGEGT Birthday004_FEGGE_GTEG

Вот файлы примеров. Для простоты я не добавляю вторую рабочую таблицу, в которой я бы хотел увеличить число в выходном файле на основе сравнения информации в исходной рабочей таблице и этой рабочей таблице:

Вот исходный файл :

Source file

Вот выходной файл:

Output file

Здесь мой текущий результат ... с макросом, который далек от того, что я пытаюсь сделать

enter image description here

Вот код:

Option Explicit

Sub Snouba()

    Const q = """"

' get source data table from sheet 1
    With ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion
        ' check if data exists

        If .Rows.Count < 2 Or .Columns.Count < 2 Then
            MsgBox "No data table"
            Exit Sub
        End If

        ' retrieve headers name and column numbers dictionary
        Dim headers As Object
        Set headers = CreateObject("Scripting.Dictionary")
        Dim headCell
        For Each headCell In .Rows(1).Cells
            headers(headCell.Value) = headers.Count + 1
        Next

        ' check mandatory headers
        For Each headCell In Array("Nabou", "Wurp", "Scope 1", "Scope 2", "Scope 3”, "Scope 4", "NipandNup")
            If Not headers.Exists(headCell) Then
                MsgBox "Header '" & headCell & "' doesn't exists"
                Exit Sub
            End If

        Next

        Dim data

        ' retrieve table data
        data = .Resize(.Rows.Count - 1).Offset(1).Value
    End With

    ' process each row in table data
    Dim result As Object
    Set result = CreateObject("Scripting.Dictionary")
    Dim i
    For i = 1 To UBound(data, 1)


     Select Case True
            Case _
                data(i, headers("NipandNup")) = "Nip"
                    MsgBox "Empty row"
                    Exit For

            Case _
                  result(result.Count) = "Nip"

            Case Else
                     result(result.Count) = "Nup"

               End Select








        Select Case True
            Case _
                data(i, headers("Nabou")) = "" Or _
                data(i, headers(""Wurp")) = "" Or _
                data(i, headers("NipandNup")) = ""
                    MsgBox "Empty row"
                    Exit For
            Case _
                data(i, headers("Scope 1")) = "" And _
                data(i, headers("Scope 2")) = "" And _
                data(i, headers("Scope 3")) = "" And _
                data(i, headers("Scope 4")) = ""
                    result(result.Count) = _
                        data(i, headers("Nabou")) & _
                        "_Alpha" & _
                        "_" & data(i, headers("Wurp")) & _
                        "_" & data(i, headers("NipandNup"))



           Case Else
                    result(result.Count) = _
                        data(i, headers("Nabou")) & _
                        "_Alphabet" & _
                        "_" & data(i, headers("Wurp")) & _
                        "_" & data(i, headers("NipandNup"))

        End Select

       Next

    ' output result data to sheet 2
    If result.Count = 0 Then
        MsgBox "No result data for output"
        Exit Sub
    End If
    With ThisWorkbook.Sheets(2)
        .Cells.Delete
        .Cells(1, 1).Resize(result.Count).Value = _
            WorksheetFunction.Transpose(result.Items())
    End With
    MsgBox "Completed"

End Sub

Мне удается успешно переименовать столбцы с этим, но это не копирование столбцов на втором листе, и, очевидно, не их содержимое:

Option Explicit

Sub Changeheadername()

    Dim lastCol As Long, idCount As Long, nameCount As Long, headerRow As Long
    Dim rng As Range, cel As Range

    headerRow = 1       'row number with headers
    lastCol = Cells(headerRow, Columns.Count).End(xlToLeft).Column 'last column in header row
    idCount = 1
    nameCount = 1
    Set rng = Sheets("Sheet1").Range(Cells(headerRow, 1), Cells(headerRow, lastCol)) 'header range

    For Each cel In rng                     'loop through each cell in header
        If cel = "Wurp" Then             'check if header is "Wurp"
            cel = "Snouba"                    'rename 

        ElseIf cel = "Nabou" Then       'check if header is "Nabou"
            cel = "WAGD"                     'rename 

              ElseIf cel = "Scope 1" Then       'check if header is "Scope 1"
            cel = "I am an a wise rabbit"             

        End If
    Next cel
End Sub

1 Ответ

1 голос
/ 26 февраля 2020

Вот пример, показывающий, как вы можете ссылаться на столбцы по именам их заголовков при обработке данных таблицы, даже если столбцы расположены в другом порядке:

Option Explicit

Sub test()

    Const q = """"
    ' get source data table from sheet 1
    With ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion
        ' check if data exists
        If .Rows.Count < 2 Or .Columns.Count < 2 Then
            MsgBox "No data table"
            Exit Sub
        End If
        ' retrieve headers name and column numbers dictionary
        Dim headers As Object
        Set headers = CreateObject("Scripting.Dictionary")
        Dim headCell
        For Each headCell In .Rows(1).Cells
            headers(headCell.Value) = headers.Count + 1
        Next
        ' check mandatory headers
        For Each headCell In Array("Client", "Info Superman", "ID", "Spec 1", "Spec 2", "Spec a", "Spec b", "Info costumer type", "Info facility type")
            If Not headers.Exists(headCell) Then
                MsgBox "Header '" & headCell & "' doesn't exists"
                Exit Sub
            End If
        Next
        Dim data
        ' retrieve table data
        data = .Resize(.Rows.Count - 1).Offset(1).Value
    End With
    ' process each row in table data
    Dim result As Object
    Set result = CreateObject("Scripting.Dictionary")
    Dim i
    For i = 1 To UBound(data, 1)
        Select Case True
            Case _
                data(i, headers("Client")) = "" Or _
                data(i, headers("Info Superman")) = "" Or _
                data(i, headers("ID")) = "" Or _
                data(i, headers("Info costumer type")) = "" Or _
                data(i, headers("Info facility type")) = ""
                    MsgBox "Empty row"
                    Exit For
            Case _
                data(i, headers("Spec 1")) = "" And _
                data(i, headers("Spec 2")) = "" And _
                data(i, headers("Spec a")) = "" And _
                data(i, headers("Spec b")) = ""
                    result(result.Count) = _
                        q & "Client " & data(i, headers("Client")) & _
                        q & q & "Superman " & data(i, headers("Info Superman")) & _
                        q & "Bravo" & _
                        q & "Info costumer type" & data(i, headers("Info costumer type")) & _
                        q & "Info facility type" & data(i, headers("Info facility type")) & _
                        q
            Case _
                data(i, headers("Spec a")) = "" And _
                data(i, headers("Spec b")) = ""
                    result(result.Count) = _
                        q & "Client " & data(i, headers("Client")) & _
                        q & q & "Superman " & data(i, headers("Info Superman")) & _
                        q & "AlphaBravo" & _
                        q & "Info costumer type" & data(i, headers("Info costumer type")) & _
                        q & "Info facility type" & data(i, headers("Info facility type")) & _
                        q
            Case Else
                    result(result.Count) = _
                        q & "Client " & data(i, headers("Client")) & _
                        q & q & "Superman " & data(i, headers("Info Superman")) & _
                        q & "AlphaAlphaBravo" & _
                        q & "Info costumer type" & data(i, headers("Info costumer type")) & _
                        q & "Info facility type" & data(i, headers("Info facility type")) & _
                        q
        End Select
    Next
    ' output result data to sheet 2
    If result.Count = 0 Then
        MsgBox "No result data for output"
        Exit Sub
    End If
    With ThisWorkbook.Sheets(2)
        .Cells.Delete
        .Cells(1, 1).Resize(result.Count).Value = _
            WorksheetFunction.Transpose(result.Items())
    End With
    MsgBox "Completed"

End Sub

Исходные данные на листе 1, который я тестировал выглядит следующим образом:

source

И вывод на листе 2 составляет

result

Это всего лишь шаблон, вы можете легко изменить код и настроить лог c для вашего точного макета.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...