Tìm nhiều trận đấu

Cột đầu tiên trong bảng tính của tôi là danh sách các tên nhóm. Một số cột tiếp theo chứa tên người chơi. Một người chơi có thể ở nhiều đội. Cuối cùng, tôi có một cột với danh sách tên người chơi.

Tôi muốn đi xuống danh sách các cầu thủ và tìm ra mỗi đội đang chơi. Thứ tự không quan trọng

Tôi có thể làm cái này như thế nào?

Ví dụ: đã cho:

red | tom | bob | sally | emma
blue | tom | george | bill | sally
green | george | bob
yellow | sally| arthur | george | emma

Tôi muốn kết quả là:

tom | red | blue
bob | red | green
sally | red | blue | yellow
george | blue | green | yellow
arthur | yellow
emma | yellow | red

Bạn sẽ cần phải kích hoạt VBA cho việc này. Sau đó, bạn muốn dán cái này vào trình soạn thảo VBA của bạn sau bất cứ điều gì khác:

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

Sau đó, bạn muốn thêm một phương thức gọi nó. Ví dụ: nếu bạn có một nút thì bạn sẽ sử dụng một cái gì đó như thế này:

Sub Button1_Click()
    CreateWorksheet_TransposedListing Range("A1:E4"), "TestSheet"
End Sub