| |
下記のマクロで製品の原料費の計算をしています。
シート（配合台帳）のＢ列のReNoナンバー（R1001〜R1800以上）をtxtReNo.Text
に入力後、 検索、修正ボタンをクリックすると原料費の計算結果が シート（配合台帳）の行（入力ReNoナンバー）、列(18)に記載されます。
これをReNoナンバーR1001からR1800以上まで自動的に連続して検索、修正、配合台帳への記載を行いたいのですが方法があれば、教えて頂けませんか、宜しくお願いします。
' =================================================
' 検索コマンドボタンがクリックされたときのプロシージャ
' =================================================
Private Sub cmd検索_Click()
Dim strキー As String
strキー = txtReNo.Text
num配合 = Application.Match(strキー, rng配合.Columns(1), 0)
'検索した得意先データをテキストボックスに代入する
txtReNo.Text = rng配合.Cells(num配合, 1)
txt収率1.Text = rng配合.Cells(num配合, 16)
txt原料費.Text = rng配合.Cells(num配合, 17)
txt加工賃.Text = rng配合.Cells(num配合, 18)
txt原料1.Text = rng配合.Cells(num配合, 20)
txt比率1.Text = rng配合.Cells(num配合, 21)
txt原料2.Text = rng配合.Cells(num配合, 22)
txt比率2.Text = rng配合.Cells(num配合, 23)
txt原料3.Text = rng配合.Cells(num配合, 24)
txt比率3.Text = rng配合.Cells(num配合, 25)
txt原料4.Text = rng配合.Cells(num配合, 26)
txt比率4.Text = rng配合.Cells(num配合, 27)
txt原料5.Text = rng配合.Cells(num配合, 28)
txt比率5.Text = rng配合.Cells(num配合, 29)
P_受注額計算 1
P_受注額計算 2
P_受注額計算 3
P_受注額計算 4
P_受注額計算 5
End Sub
' =================================================
' 修正コマンドボタンがクリックされたときのプロシージャ
' =================================================
Private Sub cmd修正_Click()
Dim strキー As String
strキー = txtReNo.Text
'ReNoのレコードを検索する
num配合 = Application.Match(strキー, rng配合.Columns(1), 0)
'修正内容を該当のレコードに書き込む
rng配合.Cells(num配合, 1) = txtReNo.Text
rng配合.Cells(num配合, 16) = txt収率1.Text
rng配合.Cells(num配合, 17) = txt原料費.Text
rng配合.Cells(num配合, 18) = txt加工賃.Text
rng配合.Cells(num配合, 20) = txt原料1.Text
rng配合.Cells(num配合, 21) = txt比率1.Text
rng配合.Cells(num配合, 22) = txt原料2.Text
rng配合.Cells(num配合, 23) = txt比率2.Text
rng配合.Cells(num配合, 24) = txt原料3.Text
rng配合.Cells(num配合, 25) = txt比率3.Text
rng配合.Cells(num配合, 26) = txt原料4.Text
rng配合.Cells(num配合, 27) = txt比率4.Text
rng配合.Cells(num配合, 28) = txt原料5.Text
rng配合.Cells(num配合, 29) = txt比率5.Text
'各テキストボックスの内容をクリアする
P_項目クリア
End Sub
' ======================================
' TxT原料１が変更になったときのプロシージャ
' ======================================
Private Sub txt原料1_Change()
Dim VV As Range
Worksheets("商品台帳").Select
With Range("B3:K65536")
Set VV = .Find(txt原料1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not VV Is Nothing Then
txt原料名1.Value = VV.Offset(, 1).Value
txt単価1.Value = VV.Offset(, 3).Value
Else
End If
End With
P_受注額計算 1
End Sub
' ======================================
' TxT原料２が変更になったときのプロシージャ
' ======================================
Private Sub txt原料2_Change()
Dim VV As Range
Worksheets("商品台帳").Select
With Range("B3:K65536")
Set VV = .Find(txt原料2.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not VV Is Nothing Then
txt原料名2.Value = VV.Offset(, 1).Value
txt単価2.Value = VV.Offset(, 3).Value
Else
End If
End With
P_受注額計算 2
End Sub
' ==========================================
' 比率と単価から原料費を計算するプロシージャ
' ==========================================
Private Sub P_受注額計算(intCol As Integer)
If IsNumeric(txt比率(intCol).Text) And IsNumeric(txt単価(intCol).Text) Then
txt金額(intCol).Text = _
Format(CDbl(txt比率(intCol).Text) * CDbl(txt単価(intCol).Text) / 100, "#,##0.00")
txt合計額(1).Text = Val(txt金額(1).Text) + Val(txt金額(2).Text) + Val(txt金額(3).Text) _
+ Val(txt金額(4).Text) + Val(txt金額(5).Text)
txt原料費.Text = Format(txt合計額(1).Text / txt収率1.Text + 0.45, "#,##0")
Else
txt金額(intCol).Text = ""
End If
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
