Excel에서 여러 열을 그룹화하고 전치합니다.

Question

회사, 지점, 회사 데이터 및 연락처로 가득 찬 Excel 시트가 있습니다.

동일한 회사 및 지점 도시에 대한 데이터를 그룹화한 다음 각 단일 열에 회사/지점 헤더 정보, contact1, contact2, contact3 등이 포함되도록 전환하려고 합니다. 그런 다음 다음 열, 다음 회사 /Branch 헤더 정보, 그 다음 연락처입니다. 각 연락처에는 이름과 성, 직함이 연결되어 있어야 하며 이름과 성으로 정렬되어야 합니다.

자주 변경되므로 주어진 데이터(첫 번째 샷)에 대해 정기적으로 이 작업을 수행하고 싶습니다. 수식, VBA, 피벗 테이블을 사용하여 수행하는 것이 가장 좋습니까? 어떤 도움이라도 주시면 감사하겠습니다.

편집하다
Ron의 우아한 솔루션에 대한 모든 단계를 아래에 추가하면 됩니다.
1. 워크시트를 매크로 지원(.xlsm) 워크시트에 저장합니다.
2. 기본 시트가 sheet1인지 확인합니다.
3. sheet2라는 빈 대상 시트를 만듭니다.
4. VBA 편집기(Alt-F11)
5. 삽입, 클래스 모듈을 클릭한 다음 클래스 모듈 코드를 붙여넣습니다
. 6. F4를 눌러 클래스 모듈의 속성 창을 확인한 다음 이름 필드에서 cCompanyInfo로 변경합니다
. 7. 삽입, 모듈을 클릭합니다. 을 클릭 하고 일반 모듈 코드를 붙여넣습니다
. 8. 도구, 참조를 클릭한 다음 Microsoft Scripting Runtime을 찾아 상자를 선택하고 확인을 클릭합니다.
9. 워크시트로 돌아가서 Alt-F8을 눌러 매크로를 보고 실행을 클릭합니다.

sheet2는 형식이 지정된 데이터로 채워집니다.

매크로 보기 대화 상자의 옵션 버튼을 사용하여 매크로를 실행하는 키보드 단축키를 지정할 수도 있습니다.

Answer 1

• 매크로를 기록하고 매크로 단축키를 할당한 후 작업을 수행하세요.
• 복사 > 선택하여 붙여넣기 > 전치 > 커서 놓기 [enter]
• 이렇게 텍스트를 연결(&)하세요.조 블로우, 혼초 수석수식 포함
• =M5&" "&M6&", "&M7
  • 여기서 이 셀에는 4개의 항목이 포함되어 있습니다. 큰따옴표에는 공백과 쉼표가 포함됩니다.

Answer 2

원본 데이터를 몇 가지 변경했습니다.

특히 순서가 잘못되어 있고 다른 항목과 ABC Corp.다른 마지막 행을 추가했습니다 .Note

코딩에서 이것이 어떻게 처리되는지 확인할 수 있으며, 필요한 경우 전화번호가 다른 경우에도 유사한 기술을 사용할 수 있습니다.

전화번호의 경우, 일관되게 입력되지 않은 경우를 대비하여 일관된 형식으로 표시될 수 있도록 숫자가 아닌 요소를 제거했습니다. 실제 데이터의 변동성에 따라 이 알고리즘을 수정해야 할 수도 있습니다.

결과가 "멋져 보이도록" 몇 가지 형식을 지정했습니다. 아무것도 사용하지 않거나 다른 서식을 선호할 수도 있습니다. 일반 모듈에서 워크시트 이름을 조정해야 할 수도 있습니다.

향후에도 이를 유지할 수 있도록 코드와 주의사항을 반드시 읽고 이해하시기 바랍니다.

원본 데이터:

수업 모듈

이거 이름 꼭 바꾸세요c회사정보

Option Explicit
'Rename this class module:  cCompanyInfo

Const dictKey = 1
Const dictItem = 2

Private pCompany As String
Private pBranch As String
Private pPhone As Currency
Private pNote As String
Private pNotes As Dictionary
Private pFirstName As String
Private pLastName As String
Private pTitle As String
Private pNameTitles As Dictionary

Public Property Get Company() As String
    Company = pCompany
End Property
Public Property Let Company(Value As String)
    pCompany = Value
End Property

Public Property Get Branch() As String
    Branch = pBranch
End Property
Public Property Let Branch(Value As String)
    pBranch = Value
End Property

Public Property Get Phone() As Currency
    Phone = pPhone
End Property
Public Property Let Phone(Value As Currency)
    pPhone = Value
End Property

Public Property Get Note() As String
    Note = pNote
End Property
Public Property Let Note(Value As String)
    pNote = Value
End Property

Public Property Get FirstName() As String
    FirstName = pFirstName
End Property
Public Property Let FirstName(Value As String)
    pFirstName = Value
End Property

Public Property Get LastName() As String
    LastName = pLastName
End Property
Public Property Let LastName(Value As String)
    pLastName = Value
End Property

Public Property Get Title() As String
    Title = pTitle
End Property
Public Property Let Title(Value As String)
    pTitle = Value
End Property

Public Property Get Notes() As Dictionary
    Set Notes = pNotes
End Property
Public Function ADDNote(Value As String)
    If Not pNotes.Exists(Value) Then pNotes.Add Value, Value
End Function

Public Property Get NameTitles() As Dictionary
    Set NameTitles = pNameTitles
End Property
Public Function ADDNameTitle(S As String)
    If Not pNameTitles.Exists(S) Then pNameTitles.Add S, S
End Function

Private Sub Class_Initialize()
    Set pNotes = New Dictionary
    Set pNameTitles = New Dictionary
End Sub

'Dictionary Sort routine
'Shamelessly copied From  https://support.microsoft.com/en-us/kb/246067

Public Sub SortDictionary(objDict, intSort)
  ' declare our variables
  Dim strDict()
  Dim objKey
  Dim strKey, strItem
  Dim X, Y, Z

  ' get the dictionary count
  Z = objDict.Count

  ' we need more than one item to warrant sorting
  If Z > 1 Then
    ' create an array to store dictionary information
    ReDim strDict(Z, 2)
    X = 0
    ' populate the string array
    For Each objKey In objDict
        strDict(X, dictKey) = CStr(objKey)
        strDict(X, dictItem) = CStr(objDict(objKey))
        X = X + 1
    Next

    ' perform a a shell sort of the string array
    For X = 0 To (Z - 2)
      For Y = X To (Z - 1)
        If StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare) > 0 Then
            strKey = strDict(X, dictKey)
            strItem = strDict(X, dictItem)
            strDict(X, dictKey) = strDict(Y, dictKey)
            strDict(X, dictItem) = strDict(Y, dictItem)
            strDict(Y, dictKey) = strKey
            strDict(Y, dictItem) = strItem
        End If
      Next
    Next

    ' erase the contents of the dictionary object
    objDict.RemoveAll

    ' repopulate the dictionary with the sorted information
    For X = 0 To (Z - 1)
      objDict.Add strDict(X, dictKey), strDict(X, dictItem)
    Next

  End If

End Sub

일반 모듈

Option Explicit
'Set Reference to Microsoft Scripting Runtime

Sub ConsolidateCompanyInfo()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim cCI As cCompanyInfo, dictCI As Dictionary
    Dim sNT As String
    Dim I As Long, J As Long, L As Currency, S As String
    Dim LastRow As Long, LastCol As Long

'Change worksheets names as appropriate
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
    Set rRes = wsRes.Cells(1, 1)

'Read the data into an array
With wsSrc
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    vSrc = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With

'Organize and Collect the data
Set dictCI = New Dictionary
For I = 2 To UBound(vSrc, 1)
    Set cCI = New cCompanyInfo
    With cCI
        .Company = vSrc(I, 1)
        .Branch = vSrc(I, 2)

        'Remove non-numeric characters from phone number for consistency
        'might need to add other Replace functions, or use Regex
        L = Replace(vSrc(I, 3), "-", "")

        .Phone = L
        .Note = vSrc(I, 4)
        .ADDNote .Note
        .FirstName = vSrc(I, 5)
        .LastName = vSrc(I, 6)
        .Title = vSrc(I, 7)
        sNT = .FirstName & " " & .LastName & ", " & .Title
        .ADDNameTitle sNT
        S = .Company & "|" & .Branch
        If Not dictCI.Exists(S) Then
            dictCI.Add S, cCI
        Else
            dictCI(S).ADDNote .Note
            dictCI(S).ADDNameTitle sNT
        End If
    End With
Next I

'Populate Results array
Dim V, W
I = 0

'First need to size the sections
Const lHeader As Long = 3 'Name, Branch, Phone number Rows
Dim lNotes As Long
Dim lContacts As Long

For Each V In dictCI
    With dictCI(V)
        lNotes = IIf(lNotes > .Notes.Count, lNotes, .Notes.Count)
        lContacts = IIf(lContacts > .NameTitles.Count, lContacts, .NameTitles.Count)
    End With
Next V

ReDim vRes(1 To lHeader + 1 + lNotes + 1 + lContacts, 1 To dictCI.Count)

J = 0
For Each V In dictCI
    J = J + 1
    With dictCI(V)
        vRes(1, J) = .Company
        vRes(2, J) = .Branch
        vRes(3, J) = .Phone
        I = lHeader + 1

        For Each W In .Notes
            I = I + 1
            vRes(I, J) = .Notes(W)
        Next W

        I = lHeader + 1 + lNotes + 1

        .SortDictionary .NameTitles, 1
        For Each W In .NameTitles
            I = I + 1
            vRes(I, J) = .NameTitles(W)
        Next W
    End With

Next V

'Write the results
Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes

    'Do some formatting to pretty things up
    'You could certainly do something different
    Range(.Rows(1), .Rows(lHeader)).Style = "Input"
    Range(.Rows(lHeader + 2), .Rows(lHeader + 1 + lNotes)).Style = "Note"
    Range(.Rows(lHeader + 1 + lNotes + 2), .Rows(lHeader + 1 + lNotes + 1 + lContacts)).Style = "Output"
    With .Rows(3)  'Format the phone number
        .NumberFormat = "000-000-0000"
        .HorizontalAlignment = xlLeft
    End With
    .EntireColumn.AutoFit
End With

End Sub

결과: