VBA 重複データ処理についてアドバイスを

Question

前提・実現したいこと

現在、符号と個数、番号を入力して同じ符号を伴った番号を入力したとき、
符号と個数は統合されるも番号は追加される、下図のようなリストを作成しています。
C列で番号を入力したときにTarget.Offsetによって、A列で同じ符号を探すようにしたいのですが、
Targetで選んだセルの値を、同じ符号のある列のセルに渡すにはどうすればいいでしょうか。
またその際、符号をDictionaryオブジェクトで探せばよいのか、それとも別のオブジェクトを使うべきなのか分かりません。
そもそも考え方が分からないので、アドバイスだけでもお願いします。

該当のソースコード

完成していないのですが、一応の参考として載せています。

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

    Dim SearchRange As Range
    Dim ResultRange As Range
    Dim KeyItem     As String
    Set SearchRange = Range("A1:A1000") 
    

With Target
If .Column = 3 And .Row >= 2 And .Value <> "" Then
    If .Value <> "" Then
        .Value = "(" & .Offset(0, -1).Value & ")" & .Value

    KeyItem = .Offset(0,-2).Value　'符号をキーにして探す
　　Set ResultRange = SearchRange.Find(KeyItem, LookAt:=xlPart)
    
  	  If Not ResultRange Is Nothing Then　'同じ符号がある場合、ここで処理を行いたい
		.Value = '


  	      Exit Sub
  	  End If
    End If
End If
End With

Application.EnableEvents = True
End Sub

補足情報（FW/ツールのバージョンなど）

使用しているExcel.2013

Answer 1

入力ミスしたら大変ですよね。
今の表はあくまで入力専用として使い、
別表で一覧にした方が良いでしょう。

Comments

[memem12]

回答ありがとうございました。
自分も入力用を検討していましたが、すでに別の入力シートを作っていたので
このシートで完成させたかったのです。説明不足で申し訳ありません。

[radames1000]

入力を二度されているということでしょうか？
すでに入力シートがあるなら、そこからデータを引っ張った方が
良いと思うのですが。

[memem12]

本来の符号はもっと種類が多いので、それを整理するためのシートのようなものです。
入力に手間がかかるので使いやすいこちらのほうを採用したいと考えた次第です。

Answer 2

あまり難しいことは考えず、素直にForループ回すところから組めばいいと思いました。

↓こちらは、おそらく質問者様が想定されている動き

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim SearchRange As Range
    Dim ResultRange As Range
    Dim KeyItem     As String
    Dim ResultNumber As String
    Dim ResultValue As Long
    Dim Rng As Variant
    Set SearchRange = Range("A1:A1000")
    Set ResultRange = Range("F1:F1000")

With Target
If Target.Count > 1 Then Exit Sub
If .Column = 3 And .Row >= 2 And .Value <> "" Then

    Application.EnableEvents = False

    If .Value <> "" Then
        .Value = "(" & .Offset(0, -1).Value & ")" & .Value

        KeyItem = .Offset(0, -2).Value '符号をキーにして探す
        
        For Each Rng In SearchRange

            If Rng = KeyItem And Rng.Row <> Target.Row Then
                
                ResultNumber = Rng.Offset(0, 2) & Target.Value
                ResultValue = Rng.Offset(0, 1) + Target.Offset(0, -1).Value
                Rng.Offset(0, 1) = ResultValue
                Rng.Offset(0, 2) = ResultNumber
                
                Target.Offset(0, -2).Resize(1, 3).ClearContents
                    
                Exit For
            End If
        Next
                
    End If
End If
End With

Application.EnableEvents = True
End Sub

ただradames1000様が言われる通り、元データは元データで残して別の表として生成していく方が確実かと思います。
↓はそのような動きを想定しています。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim SearchRange As Range
    Dim ResultRange As Range
    Dim KeyItem     As String
    Dim ResultNumber As String
    Dim ResultValue As Long
    Dim Rng As Variant
    Set SearchRange = Range("A1:A1000")
    Set ResultRange = Range("F1:F1000")

With Target
If Target.Count > 1 Then Exit Sub
If .Column = 3 And .Row >= 2 And .Value <> "" Then

    Application.EnableEvents = False
    
    If .Value <> "" Then
        .Value = "(" & .Offset(0, -1).Value & ")" & .Value

        KeyItem = .Offset(0, -2).Value '符号をキーにして探す
        
        For Each Rng In SearchRange

            If Rng = KeyItem Then
                
                ResultNumber = ResultNumber & Rng.Offset(0, 2).Value
                ResultValue = ResultValue + Rng.Offset(0, 1).Value
                
            End If

            If Rng = "" Then Exit For

        Next
        
        For Each Rng In ResultRange
        
            If Rng = KeyItem Or Rng = "" Then
                Rng.Value = KeyItem
                Rng.Offset(0, 1) = ResultValue
                Rng.Offset(0, 2) = ResultNumber
            
                Exit For
            End If
        
        Next
                
    End If
End If
End With

Application.EnableEvents = True
End Sub

Comments

[memem12]

回答ありがとうございました。
参考にさせていただきます。