エクセルのマクロの質問です。次のマクロははてなで回答者の方々に作成していただいたマクロです。

私のパソコンの環境はCPU、メモリと高速な環境で少ないデータでテストしてるので、

処理時間をあまり考えないでコードしていました。

カンマは、半角・全角・「、」に対応しておきました。

Sub MacroSyouhinTenki()
    Application.ScreenUpdating = False
    
    '管理ブックのパスを環境に合わせてください
    Const myPath As String = "C:\管理"
    '商品管理のブック名
    Const wbName As String = "商品管理.xls"
    '商品管理のワークシート名
    Const wsName As String = "商品管理"
    
    Dim i As Integer
    Dim j As Long
    Dim k As Integer
    Dim l As Integer
    Dim sName As String
    Dim sNum As String
    Dim retu() As Integer
    Dim f As Boolean
    Dim rr As Integer
    Dim r As Range
    Dim sList As String
    Dim dstWS As Worksheet              '商品管理シート
    Dim raiWS As Worksheet              '来店記録シート
    Dim syouhinNum As Integer           '商品管理の商品番号列
    Dim syouhinName As Integer          '商品管理の商品名列
    Dim r1 As Range
    Dim r2 As Range
    Dim h() As String
    Dim s As Variant
    
    Set raiWS = ActiveSheet
    
    '商品管理を開く
    On Error GoTo err_Trp
    If bookCheck(myPath & "\" & wbName) Then
        Set dstWS = Workbooks(wbName).Worksheets(wsName)
    Else
        Set dstWS = Workbooks.Open(myPath & "\" & wbName).Worksheets(wsName)
    End If
    On Error GoTo 0
    
    Set r1 = dstWS.Rows(1).Find(what:="商品番号", lookat:=xlWhole)
    If r1 Is Nothing Then
        MsgBox "商品管理に商品番号の列がありません。"
        Exit Sub
    End If
    syouhinNum = r1.Column
    
    Set r2 = dstWS.Rows(1).Find(what:="商品名", lookat:=xlWhole)
    If r1 Is Nothing Then
        MsgBox "商品管理に商品名の列がありません。"
        Exit Sub
    End If
    syouhinName = r2.Column
    
    With raiWS
        '列に挿入されたることを考えて商品番号が何列目かを調べます
        i = 1
        While .Cells(1, i).Value <> "商品番号"
            i = i + 1
        Wend
        
        ReDim retu(0) As Integer
        For Each r In Selection
            rr = r.Row
            f = False
            For l = 0 To UBound(retu)
                If retu(l) = rr Then
                    f = True
                    Exit For
                End If
            Next l
            If f = False Then
                sName = ""
                sNum = ""
                k = i
                While .Cells(rr, k).Value <> ""
                    
                    h = Split(Replace(Replace(.Cells(rr, k).Value, "、", ","), "，", ","), ",")
                    
                    For Each s In h
                        j = 2
                        While dstWS.Cells(j, syouhinNum).Value <> s And _
                            dstWS.Cells(j, syouhinNum).Value <> ""
                            j = j + 1
                        Wend
                        
                        sList = dstWS.Cells(j, syouhinName).Value
                        If sList = "" Then
                            sList = "存在しない商品番号"
                        End If
                        
                        If sName = "" Then
                            sName = sList
                        Else
                            sName = sName & "," & sList
                        End If
                        If sNum = "" Then
                            sNum = s
                        Else
                            sNum = sNum & "," & s
                        End If
                    Next
                    .Cells(rr, k).Value = ""
                    k = k + 1
                Wend
                
                .Cells(rr, i - 1).Value = sName
                .Cells(rr, i).Value = sNum
                
                ReDim Preserve retu(UBound(retu) + 1) As Integer
                retu(UBound(retu)) = rr
            End If
        Next r
    End With
    
    Application.ScreenUpdating = True
    Exit Sub
    
err_Trp:
    Select Case Err.Number
        Case 1004
            MsgBox "商品管理をオープンできません。パスを確認してください。"
        Case 9
            MsgBox "商品管理の正しいブック名とシート名を指定してください。"
        Case Else
            MsgBox "商品管理をオープンすることができませんでした。"
    End Select
    Application.ScreenUpdating = True
End Sub

'ブックが開いているかをチェック
Function bookCheck(myPath As String) As Boolean
    Dim f As Boolean
    Dim myBook As Workbook
    For Each myBook In Workbooks
        If myBook.Path & "\" & myBook.Name = myPath Then
            f = True
            Exit For
        End If
    Next
    bookCheck = f
End Function