チェンジイベントを複数セル同時に適用する方法について

Question

vbaで特定の列に対しvalidationでドロップダウン（別シートの表を参照）を設定しています。

（例）
A列
１　佐藤
２　鈴木
３　田中
４　（空）

上記リストの中から値を選択すると、チェンジイベントで同じ行の特定のセルに数式が埋め込まれる仕組みです。

ドロップダウンリストから一つ一つ選択するのが面倒な時に、A列のリストと同様の値を外部ファイルか何かから複数コピーして貼り付けをすると以下★の部分に対し、「実行時エラー'13'型が一致しません」と表示されます。

' チェンジイベント発生
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim x As Long
  x = Target.Row

　' イベント範囲を指定
  If Intersect(Target, Range("H:H")) Is Nonthing Then
    Exit Sub
  Else
    Dim rateFindData As Long
    ' 選択した値が空でなかったら
    If Not IsEmpty(Target.Value) Then
　    ' find関数を実行するプロシージャの呼び出し
      rateFindData = findRateData(Target.Value)　' ★←ここでエラーになる★
　　   ' 戻り値が空でなかったら
      If Not IsEmpty(rateFindData) Then
        'K列に数式を埋め込む
　　　　　Cells(x,11).Formula = "=数式"
　　　
      End If
    End If
  End If
End Sub

' 別プロシージャ
Public Function findRateData(ByVal data As String)As Long

Dim rateSheet As Worksheet
Set rateSheet = Worksheets("担当者")

Dim c As Long
' find関数でデータを検索
c = rateSheet.Range("A2:A6").find( _
What:=data, LookIn:=xlValues, LookAt:=xlWhole).Row

findRateData = c


End Function

複数のデータを貼り付けた時のエラーを回避し、貼り付けたセル分一つ一つに上記の処理を走らせることは可能でしょうか？
おそれいりますが、ご回答のほどよろしくお願いいたします。

Comments

[meg_]

何故エラーが出ているか分かりますか？

Answer 1

複数セルが同時に変更されたとき、Targetには変更されたセル範囲が入ります。
そして、セル範囲を示すRangeオブジェクトのValueプロパティは、Variant型の2次元配列となります。
VBAの2次元配列は文字列に変換できないため、型が一致しません。のエラーが発生します。

対策としては、以下のようにFor EachでTargetを列挙し、列挙されたセル(c)に対して処理をするのがいいでしょう。
Targetが行や列の集合を示すRangeの場合はCellsプロパティでセルの集合を示すRangeに変換が必要ですが、
Worksheet_ChangeイベントのTargetであれば原則セルの集合なので問題ないです。

Dim c As Range
For Each c In Target
    If Not IsEmpty(c.Value) Then
        '以下略
    End If
Next c

---

その他気になった点としてIf Not IsEmpty(rateFindData) Thenの判定があります。

rateFindDataはLong型と宣言されているため、絶対にIsEmpty関数はFalseを返します。
IsEmptyはVariant型の値についてがEmptyという特別な値かどうか、を判定する関数なためです。整数と決まっている時点でEmptyではありません。

上記部分の削除や、親オブジェクトの明示などを行ったコードが以下になります。

' チェンジイベント発生
Private Sub Worksheet_Change(ByVal Target As Range)
    'https://teratail.com/questions/260640
    
    ' イベント範囲を指定
    If Intersect(Target, Me.Range("H:H")) Is Nothing Then
        Exit Sub
    End If
    
    Dim c As Range
    For Each c In Target
        ' 選択した値が空でなかったら
        If Not IsEmpty(c.Value) Then
            
            Dim x As Long
            x = c.Row
            
            Dim rateFindData As Long
            ' find関数を実行するプロシージャの呼び出し
            rateFindData = findRateData(c.Value)  ' ★←ここでエラーになる★
            
            'K列に数式を埋め込む
            Me.Cells(x, 11).Formula = "=数式"
            
            ' 戻り値が空でなかったら
            'If Not IsEmpty(rateFindData) Then ''絶対にTrueになる。
        End If
    Next c
End Sub

' 別プロシージャ
Public Function findRateData(ByVal data As String) As Long
    
    Dim rateSheet As Worksheet
    Set rateSheet = Me.Parent.Worksheets("担当者")
    
    Dim c As Long
    ' Find関数でデータを検索
    c = rateSheet.Range("A2:A6").Find( _
            What:=data, _
            LookIn:=xlValues, _
            LookAt:=xlWhole _
        ).Row
    
    findRateData = c
    
End Function

Comments

[pararinrinrin]

こちらの通りに実装したらうまくいきました！
「複数セルが同時に変更されたとき、Targetには変更されたセル範囲が入ります。」とご説明いただいた部分も大変参考になりました。ご丁寧にありがとうございました！