画面遷移パターン

Sub ExtractTransitionPatterns()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")

Dim outputWs As Worksheet
On Error Resume Next
Set outputWs = ThisWorkbook.Sheets("OutputSheet")
On Error GoTo 0

If outputWs Is Nothing Then
    Set outputWs = ThisWorkbook.Sheets.Add
    outputWs.Name = "OutputSheet"
End If

outputWs.Cells.Clear

Dim row As Long, col As Long, outputRow As Long
outputRow = 1

' Header for the output sheet
outputWs.Cells(outputRow, 1).Value = "元画面"
outputWs.Cells(outputRow, 2).Value = "遷移先"
outputRow = outputRow + 1

' Iterate through each row in column B
For row = 7 To ws.Cells(ws.Rows.Count, "B").End(xlUp).row ' Assuming data starts from row 7
    Dim currentScreen As String
    currentScreen = ws.Cells(row, "B").Value
    
    If currentScreen <> "" Then
        ' Check each column for the symbols
        For col = 3 To ws.Cells(6, ws.Columns.Count).End(xlToLeft).Column ' Assuming headers are in row 6
            Dim symbol As String
            symbol = ws.Cells(row, col).Value
            
            If symbol = "◯" Or symbol = "R" Or symbol = "B" Then
                Dim nextScreen As String
                nextScreen = ws.Cells(6, col).Value
                
                ' Write to the output sheet
                outputWs.Cells(outputRow, 1).Value = currentScreen
                outputWs.Cells(outputRow, 2).Value = nextScreen
                outputRow = outputRow + 1
            End If
        Next col
    End If
Next row

End Sub