Excel VBAでIF～Thenの入れ子がうまくできません。
いつもお世話になってます。
IF～Then～EndIfにIFを入れていますがうまくいきません。よろしくお願いします。
Private Sub CommandButton10_Click()
Dim i As Long
Dim 最終行 As String
Dim サーチ行 As Long
Dim 行 As Long
Dim 列 As Long
If TextBox33.Value = "" Then
MsgBox "使用量を入力してください。"
Else
If TextBox11 <> "" Then
TextBox26 = TextBox33 * TextBox11 / 100 '成分1
End If
If TextBox12 <> "" Then
TextBox25 = TextBox33 * TextBox12 / 100 '成分2
End If
Workbooks.Open Filename:=ThisWorkbook.Path & "\データ物質試薬管理.xls"
Sheets("shinki").Activate
最終行 = (Range("B2").End(xlDown).Row) '商品名の行検索
サーチ行 = 0
For i = 2 To 最終行
If ComboBox3.Value = Range("B" & i) Then
Workbooks("データ物質試薬管理.xls").Close savechanges:=False '保存しない
Workbooks.Open Filename:=ThisWorkbook.Path & "\データ物質試薬管理.xls"
Sheets("kongou").Select
Range("A65536").End(xlUp).Offset(1).Select
行 = ActiveCell.Row
列 = ActiveCell.Column
Cells(行, 列) = UserForm11.TextBox16.Value 'CAS
Cells(行, 列 + 1) = UserForm11.TextBox21.Value '使用日
Cells(行, 列 + 2) = UserForm11.TextBox29.Value '使用者
Cells(行, 列 + 4) = UserForm11.TextBox26.Value '成分1使用量
Cells(行 + 2, 列) = UserForm11.TextBox18.Value 'CAS
Cells(行 + 2, 列 + 1) = UserForm11.TextBox21.Value '使用日
Cells(行 + 2, 列 + 2) = UserForm11.TextBox29.Value '使用者
Cells(行 + 2, 列 + 4) = UserForm11.TextBox24.Value '成分3使用量
Cells(行 + 2, 列 + 5) = UserForm11.TextBox32.Value '種類
Cells(行 + 2, 列 + 6) = UserForm11.TextBox34.Value '単位
Cells(行 + 2, 列 + 7) = UserForm11.ComboBox3.Value '商品名
Workbooks("データ物質試薬管理.xls").Close savechanges:=True
'showhinに在庫管理する
Workbooks.Open Filename:=ThisWorkbook.Path & "\データ物質試薬管理.xls"
Sheets("showhin").Select
Range("A65536").End(xlUp).Offset(1).Select
行 = ActiveCell.Row
列 = ActiveCell.Column
Cells(行, 列) = UserForm11.TextBox2.Value '品名コード
Cells(行, 列 + 1) = UserForm11.ComboBox3.Value '商品名
'Cells(行, 列 + 2) = UserForm9.TextBox3.Value '１本の量
'Cells(行, 列 + 3) = UserForm9.TextBox4.Value '本数
Cells(行, 列 + 4) = UserForm11.TextBox34.Value '単位
Cells(行, 列 + 5) = UserForm11.TextBox32.Value '種別
Cells(行, 列 + 6) = UserForm11.TextBox21.Value '使用日
Cells(行, 列 + 7) = UserForm11.TextBox29.Value '使用者名
Cells(行, 列 + 9) = UserForm11.TextBox33.Value '使用量
Workbooks("データ物質試薬管理.xls").Close savechanges:=True
MsgBox "登録しました。"
End If
サーチ行 = i
Exit For
'End If
Next
If サーチ行 = 0 Then
MsgBox ComboBox3.Value & "商品は登録されておりません。" & Chr(10) & "「新規商品登録」ボタンから入力してください。"
End If
End If
If TextBox21.Value = "" Then '使用量
MsgBox "使用日を入力してください。"
End If
ComboBox3.SetFocus
End Sub
お礼
(1)の方は解決しました。 Private Sub 入力_Click() Sheets("用語").Select '入力するシートを選ぶ Range("B65536").End(xlUp).Offset(1).Select '空白のセルを選ぶ 行 = ActiveCell.Row 'アクティブセルから下へ 列 = ActiveCell.Column Cells(行, 列) = UserForm1.TextBox1.Value Cells(行, 列 + 1) = UserForm1.TextBox2.Value Cells(行, 列 + 2) = UserForm1.TextBox3.Value UserForm1.TextBox1.SetFocus Cells(行 + 1, 列).Select '次の入力のためテキストボックスを空白にする TextBox1.Value = "" TextBox2.Value = "" TextBox3.Value = "" Sheets("回答フォーム").Select End Sub ありがとうございました。 (2)の方はもう少し勉強してみます。 ありがとうございました。
補足
(1)を Private Sub 入力_Click() Sheets("用語").Select 行 = ActiveCell.Row 列 = ActiveCell.Column Cells(行, 列) = UserForm1.TextBox1.Value Cells(行, 列 + 1) = UserForm1.TextBox2.Value Cells(行, 列 + 2) = UserForm1.TextBox3.Value UserForm1.TextBox1.SetFocus Cells(行 + 1, 列).Select End Sub に変更しました。 エラーはでなくなりましたが、用語シートの セルの位置を探しにいかずに アクティブセルから入力さてしまいます。 又(2)を Private Sub CommandButton1_Click() Set sh1 = bk.Worksheets("回答フォーム")・・・・* Set sh5 = bk.Worksheets("用語") cnt1 = 2 UserForm1.TextBox1.Value = "A" A = UserForm1.TextBox1.Value '用語 sh5.Cells(n, 2).Value = sh1.TextBox1.Value '意味 sh5.Cells(n, 3).Value = sh1.TextBox3.Value '用途 sh5.Cells(n, 4).Value = sh1.TextBox2.Value End Sub に変更しました。 *が黄色になります。 何度もすみません。