|
下のコードに変更してください。
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 |
|
|
|