VBA를 사용하여 특정 헤더 이름을 검색하고 여러 이름 바꾸기 열에서 이러한 헤더의 데이터 그룹화

내가 엄밀히 수신하는 큰 파일에서 Excel 파일의 새 시트로 데이터를 재구성하려고합니다.

따라서 특정 헤더 이름을 찾고 이름을 바꾸고 데이터를 복사하거나 더 복잡한 작업을 수행합니다.

더 간단한 경우에는 열 이름 만 변경합니다. "Spec A"라는 열을 찾고 "Nabou"라는 이름을 바꿉니다.

더 복잡한 경우에는 열을 연결하여 새 열을 만듭니다. 그러나 정보가 다른 열에 있는지 여부에 따라 다양한 경우에 변경 될 수있는 특정 텍스트를 추가하고 있습니다. 예를 들어, 세 바랄 열 "nup", "nap"을 연결하고 일부 특정 헤더 아래에있는 값이있는 행에 대해 "WAGA"를 추가하고 이러한 동일한 헤더에 값이없는 행에 대해 "CIOCOLATO"를 추가합니다.

두 가지 가능한 결과는 다음과 같습니다.

• nup_nap_WAGA_Snip (특정 행에 아래 값이있는 경우 caeses 용)

• nup_nap_CIOCOLATO_Snip (특정 헤더 아래 행에 값이없는 경우)

최악의 경우 동일한 파일에서 이러한 열을 연결하여 새 열을 생성하지만 경우에 따라 특정 번호를 추가하기도합니다.
증가하고있는 번호를 알기 위해 다른 엑셀 파일 (다른 워크 시트)을 찾아 특정 조건에 따라 증가해야하는 증가분에 특정 입력을 추가해야합니다.

예를 들어이 결과를 얻을 수 있습니다. "003"은 "Lettuce"라는 용어에 대한 특정 헤더 아래의 행을 살펴보고 "lettuce"뒤에 "002"가있는 경우 "003"을 추가하는 다른 통합 문서의 검색을 기반으로합니다.

Lettuce003_SDS_FSGTEGT Cake0049_SDEWF_TGEGT Birthday004_FEGGE_GTEG

다음은 예제 파일입니다. 간단하게하기 위해 두 번째 워크 시트를 추가하지 않습니다. 여기에서 원본 워크 시트와이 워크 시트의 정보 비교를 기반으로 출력 파일의 숫자를 증가 시키려고합니다.

다음은 소스 파일입니다.

다음은 출력 파일입니다.

다음은 내 현재 결과입니다. 매크로를 사용하면 내가하려는 작업과는 거리가 멀습니다.

다음은 코드입니다.

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