Excelで取引先表を作ってみよう

Option Explicit

Private Sub Workbook_Open()
    bDataChangeFlag = False
    NowDispId = 0
    
    RecordCount = GetRecordCout
    Sheets("メイン").Range("E3") = "( /" & RecordCount & " )"
    Sheets("メイン").Range("E3").Font.Color = vbBlack
    Sheets("メイン").Range("D3:D14") = ""
End Sub

標準モジュールコード

下のコードに変更してください。

Option Explicit

'データ変更の有無
Public bDataChangeFlag As Boolean
'抽出結果の修正レコード
Public EditRecordNo As Long
'現在表示されているID
Public NowDispId As Long
'登録レコード数
Public RecordCount As Long

Private Function ExInputCheck() As Boolean
    Dim scell As String
    Dim i As Integer
    Dim lrow As Long
    Dim srow As String
    Dim tRange As Range
    
    ExInputCheck = False
    If Range("D3") = "" Then
        Range("D3").Select
        MsgBox "取引先IDは必ず入力してください。", , "取引先表"
        Exit Function
    End If
    If Range("D4") = "" Then
        Range("D4").Select
        MsgBox "会社名は必ず入力してください。"
        Exit Function
    End If
    
    If NowDispId <> Range("D3") Then
'新規保存 
       'IDの登録チェック
        If ExFindID(Range("D3"), scell) = True Then
            Range("D3").Select
            MsgBox "入力された取引先IDは会社名：" & _
                Sheets("T取引先").Range(scell).Offset(0, 1) & _
                " に既に登録されています。変更してください。", , "取引先表"
            Exit Function
        End If
        '最終行を捜す
        lrow = Sheets("T取引先").Range("A65536").End(xlUp).Row - 4
        '入力データをコピー
        For i = 1 To 12
            Sheets("T取引先").Range("A5").Offset(lrow, i - 1) = Range("D" & 2 + i)
        Next
        RecordCount = RecordCount + 1
        Sheets("メイン").Range("E3") = "( /" & RecordCount & " )"
    Else
'修正保存
        '1行目から検索
        Set tRange = Sheets("T取引先").Columns(1)
        Set tRange = tRange.Find(What:=NowDispId, LookIn:=xlValues, LookAt:=xlWhole)
        If Not tRange Is Nothing Then
            lrow = tRange.Row   '  .Address(RowAbsolute:=False, ColumnAbsolute:=False)
            '入力データをコピー
            For i = 1 To 12
                Sheets("T取引先").Range("A5").Offset(lrow - 5, i - 1) = Range("D" & 2 + i)
            Next
        End If
    End If
    ExInputClear
End Function