내 스프레드시트의 첫 번째 열은 팀 이름 목록입니다. 다음 몇 개의 열에는 플레이어 이름이 포함되어 있습니다. 플레이어는 둘 이상의 팀에 속할 수 있습니다. 마지막으로 플레이어 이름 목록이 포함된 열이 있습니다.
선수 목록을 내려가서 각 선수가 어느 팀에 속해 있는지 알아보고 싶습니다. 순서는 중요하지 않습니다
어떻게 해야 하나요?
예를 들어, 다음과 같습니다.
red | tom | bob | sally | emma
blue | tom | george | bill | sally
green | george | bob
yellow | sally| arthur | george | emma
결과는 다음과 같습니다.
tom | red | blue
bob | red | green
sally | red | blue | yellow
george | blue | green | yellow
arthur | yellow
emma | yellow | red
답변1
이를 위해서는 VBA를 활성화해야 합니다. 그런 다음 VBA 편집기에 다른 항목 뒤에 붙여넣고 싶습니다.
Sub CreateWorksheet_TransposedListing(inputData As Range, worksheetName As String)
AddNumberedSheet worksheetName
Dim new_sheet As Worksheet
Set new_sheet = Sheets(Sheets.Count)
Dim nRowDx As Integer, nColDx As Integer
Dim sValue As String, sHeader As String, sAddress As String
For nRowDx = 1 To inputData.Rows.Count
For nColDx = 1 To inputData.Columns.Count
If nColDx = 1 Then
sValue = Trim(inputData.Cells(nRowDx, nColDx).Value)
Else
sHeader = Trim(inputData.Cells(nRowDx, nColDx).Value)
sAddress = FindNextHeaderCell(new_sheet.Name, sHeader)
If sAddress = "" Then Exit Sub
new_sheet.Range(sAddress) = sValue
End If
Next
Next
End Sub
Function FindNextHeaderCell(sSheet As String, sRowHeaderName As String) As String
Dim nRowDx As Integer, nColDx As Integer
For nRowDx = 1 To 32766
If IsEmpty(Worksheets(sSheet).Cells(nRowDx, "A")) Then
Worksheets(sSheet).Cells(nRowDx, "A") = sRowHeaderName
FindNextHeaderCell = Worksheets(sSheet).Cells(nRowDx, "B").Address
Exit Function
ElseIf Worksheets(sSheet).Cells(nRowDx, "A") = sRowHeaderName Then
For nColDx = 2 To 32766
If IsEmpty(Worksheets(sSheet).Cells(nRowDx, nColDx)) Then
FindNextHeaderCell = Worksheets(sSheet).Cells(nRowDx, nColDx).Address
Exit Function
End If
Next
If nColDx > 32766 Then
MsgBox "This result is larger than VBA will support. Results have been truncated."
FindNextHeaderCell = ""
Exit Function
End If
End If
Next
If nRowDx > 32766 Then
MsgBox "This result is larger than VBA will support. Results have been truncated."
End If
FindNextHeaderCell = ""
End Function
Sub AddNumberedSheet(Optional sWorksheetName As String, Optional bSelectWorksheet As Boolean)
Dim sheet_name As String, num_text As String
Dim i As Integer, new_num As Integer, max_num As Integer
Dim new_sheet As Worksheet
max_num = 0
For i = 1 To Sheets.Count
sheet_name = Sheets(i).Name
If Left$(sheet_name, Len(sWorksheetName)) = sWorksheetName Then
num_text = Mid$(sheet_name, Len(sWorksheetName) + 1)
new_num = Val(num_text)
If new_num > max_num Then max_num = new_num
End If
Next i
Set new_sheet = Sheets.Add(after:=Sheets(Sheets.Count))
new_sheet.Name = sWorksheetName & Format$(max_num + 1)
If bSelectWorksheet Then new_sheet.Select
End Sub
그런 다음 이를 호출하는 메서드를 추가하려고 합니다. 예를 들어 버튼이 있는 경우 다음과 같이 사용합니다.
Sub Button1_Click()
CreateWorksheet_TransposedListing Range("A1:E4"), "TestSheet"
End Sub