| 
    
     |  | Keinさん ありがとうございました x、yの項目を増やしてデータを入れデバックしたところ x、y同一座標のセルにカウントされません どこを直せばいいんでしょうか
 
 ▼Kein さん:
 >それなら↓このように、コードを大幅に省略することとMatch関数の戻り値の判定を
 >追加することで、うまくいくと思いますが。
 >
 >Sub Test_Count2()
 >  Dim MyR As Range, C As Range
 >  Dim x As Variant, y As Variant
 >
 >  Application.ScreenUpdating = False
 >  With Sheets("Sheet1")
 >    Set MyR = .Range("A1", .Range("A65536").End(xlUp))
 >  End With
 >  With Sheets("Sheet2")
 >   For Each C In MyR
 >     x = Application.Match(C.Value, .Range("A:A"), 0)
 >     y = Application.Match(C.Offset(, 1).Value, .Rows(1), 0)
 >    If Not IsError(x) And Not IsError(y) Then
 >      .Cells(x, y).Value = .Cells(x, y).Value + 1
 >    End If
 >   Next
 >   .Activate
 >  End With
 >  Application.ScreenUpdating = True: Set MyR = Nothing
 >End Sub
 >
 >Sheet1 の1行目が項目なら、
 >
 >Set MyR = .Range("A2", .Range("A65536").End(xlUp))
 >
 >と、変更して下さい。
 
 |  |