たたき台です。

 Sub test()
    Dim fso As Object, f As Object
    Dim dic As Object
    Dim ws As Worksheet, ym As String
     Dim p As String, w()
    Dim 評価者 As String, 被評価者 As String, 評価 As String
    Dim n As Long
    
    Set fso = CreateObject("scripting.filesystemobject")
    Set dic = CreateObject("scripting.dictionary")
    
    Set ws = ActiveSheet      '★アウトプットファイル（シート）
    ym = "2021." & Val(ActiveSheet.Name)
    
    p = "D:\test\"      '★インプットファイルの場所

    ReDim w(1 To fso.getfolder(p).Files.Count, 1 To 5)

    For Each f In fso.getfolder(p).Files
        If LCase(f.Name) Like "*" & ym & ".*.xlsx" Then
            With Workbooks.Open(f.Path).Sheets(1)
                評価者 = .Range("A2").Value
                被評価者 = .Range("B2").Value
                評価 = .Range("C2").Value
                .Parent.Close False
            End With
            n = InStr("**〇△×", 評価)
            If n > 2 Then
                If Not dic.exists(評価者) Then
                    dic(評価者) = dic.Count + 1
                    w(dic(評価者), 1) = 評価者
                End If
                If Not dic.exists(被評価者) Then
                    dic(被評価者) = dic.Count + 1
                    w(dic(被評価者), 1) = 被評価者
                End If
                w(dic(評価者), 2) = w(dic(評価者), 2) + 1
                w(dic(被評価者), n) = w(dic(被評価者), n) + 1
            End If
        End If
    Next
        
    With ws.UsedRange.Offset(2)
        .ClearContents
        .Resize(dic.Count, 5).Value = w
    End With
 
 End Sub

こんにちは。

アウトプットの形式が以下のように変更になってしまいました。
A〜D列は変更不可。　E〜M列も別のデータ（計算式等）が入っています。


■　アウトプットファイル＞

    A     B   　C　　　D　　　　　　 N　 　　　　　　　　O     P     Q　　　　
 8　　　　　　　　　　　　　　　　　　　　　　　　　　自分が評価された件数
 9 項番 課名　役職　名前     自分が評価した件数        良好　普通　その他
10  1   役員  社長　鈴木　　　　　　　　　   　     
11  1 　総務　部長　田中
12  2　 総務　課長　山田
13  3 　総務　係長　久保田
14  4　 総務　主任　吉田
15  1　 経理　部長　山田
16  2　 経理　課長　古谷




教えて頂いたマクロを色々なサイトを見ながら研究して（完全に理解できたとは言い難いですが…）以下部分を変更すれば良いのは分かったのですが、どう直したら良いかが分かりません。

    With ws.UsedRange.Offset(2)
        .ClearContents
        .Resize(dic.Count, 5).Value = w
    End With
 

教えていただけないでしょうか？　何度もごめんなさい。


もう１つ　勉強のために確認させて頂きたいのですが

    n = InStr("**〇△×", 評価)

というコードがありますが
（　※の部分は    n = InStr("**良好普通その他", 評価)　　　に変更します）

"**" は何故必要なのでしょうか？

＞n = InStr("**〇△×", 評価)

評価が、○なら3文字目、△なら4文字目、×なら5文字目という意味です
以下のほうがわかりやすかったですね。

Select Case 評価
    Case "○": n = 3
    Case "△": n = 4
    Case "×": n = 5
    Case Else: n = 0
End Select

配列w の1次元目のインデックスを
愛とプットファイルの並びとすればよいです。

    Set ws = ActiveSheet      '★アウトプットファイル（シート）
    For Each c In ws.Range("C10", ws.Range("C10").End(xlDown))
        評価者 = c.Value
        dic(評価者) = dic.Count + 1
    Next
    
    ReDim w(1 To dic.Count, 1 To 4)

こんにちは。
色々試してみましたが、ダメでした・・・


以前マナーさんから以下のアドバイスを頂きましたが、理解できませんでした。


>配列w の1次元目のインデックスを
>iとアウトプットファイルの並びとすればよいです。


以下のVBAを具体的にどこへ入れれば良いのでしょうか？
時間が経ってしまい大変申し訳ありませんが、教えてください。
よろしくお願い致します。


    Set ws = ActiveSheet      '★アウトプットファイル（シート）
    For Each c In ws.Range("C10", ws.Range("C10").End(xlDown))
        評価者 = c.Value
        dic(評価者) = dic.Count + 1
    Next
    
    ReDim w(1 To dic.Count, 1 To 4)