ExcelVBA作例5(合成レシピ:データ転記)
- 僕が実験で使う薬品の配合レシピを管理するExcelブックにはマクロが組まれています
[http://:title]
- このブックには5つのボタンに5種類のマクロを組んであるので、これらをひとつづつ紹介していこうと思います
-
「見積書」のシートで組んだレシピを保存用の「合成一覧」シートに転記するマクロです。
Option Explicit
Sub 見積データ転記()
Dim 数 As Integer
Dim セル As Range
On Error GoTo エラー処理
数 = Range(Cells(15, 3), Cells(15, 30)).SpecialCells(xlCellTypeFormulas).Count
If Range("G15").Value = "" Then
数 = 数 - 1
End If
If Range("D15").Value = "" Then
数 = 数 - 1
End If
If Range("C15").Value = "" Then
数 = 数 - 1
End If
Range("E3").Value = Now
Dim 最終列 As Integer
最終列 = Cells(15, 30).End(xlToLeft).Column
Set セル = Worksheets("合成一覧").Range("A1048576").End(xlUp).Offset(1)
Range("E3").Copy
セル.Resize(数).PasteSpecial xlPasteValuesAndNumberFormats
Range("E4").Copy
セル.Offset(0, 1).Resize(数).PasteSpecial xlPasteValuesAndNumberFormats
Range("C8").Copy
セル.Offset(0, 2).Resize(数).PasteSpecial xlPasteValuesAndNumberFormats
If Range("C15").Value <> "" Then
セル.Offset(0, 3).Value = "モノマー"
セル.Offset(0, 4).Value = Worksheets("見積書").Range("C12").Value
セル.Offset(0, 5).Value = Worksheets("見積書").Range("C13").Value
セル.Offset(0, 6).Value = Worksheets("見積書").Range("C7").Value
セル.Offset(0, 7).Value = (100 - Worksheets("見積書").Range("G14").Value) * Worksheets("見積書").Range("C14").Value
セル.Offset(0, 8).Value = Worksheets("見積書").Range("C15").Value * 10 ^ 3 * (1000 / Worksheets("見積書").Range("C8").Value) / Worksheets("見積書").Range("C13").Value
セル.Offset(0, 9).Value = Worksheets("見積書").Range("C15").Value
End If
If Range("D15").Value <> "" Then
セル.Offset(1, 3).Value = "モノマー"
セル.Offset(1, 4).Value = Worksheets("見積書").Range("D12").Value
セル.Offset(1, 5).Value = Worksheets("見積書").Range("D13").Value
セル.Offset(1, 6).Value = Worksheets("見積書").Range("C7").Value
セル.Offset(1, 7).Value = (100 - Worksheets("見積書").Range("G14").Value) * Worksheets("見積書").Range("D14").Value
セル.Offset(1, 8).Value = Worksheets("見積書").Range("D15").Value * 10 ^ 3 * (1000 / Worksheets("見積書").Range("C8").Value) / Worksheets("見積書").Range("D13").Value
セル.Offset(1, 9).Value = Worksheets("見積書").Range("D15").Value
End If
Set セル = Worksheets("合成一覧").Range("D1048576").End(xlUp).Offset(1)
If Range("G15").Value <> "" Then
セル.Value = "架橋剤"
セル.Offset(0, 1).Value = Worksheets("見積書").Range("G12").Value
セル.Offset(0, 2).Value = Worksheets("見積書").Range("G13").Value
セル.Offset(0, 3).Value = Worksheets("見積書").Range("C7").Value
セル.Offset(0, 4).Value = Worksheets("見積書").Range("G14").Value
セル.Offset(0, 5).Value = Worksheets("見積書").Range("G15").Value * 10 ^ 3 * (1000 / Worksheets("見積書").Range("C8").Value) / Worksheets("見積書").Range("G13").Value
セル.Offset(0, 6).Value = Worksheets("見積書").Range("G15").Value
End If
Set セル = Worksheets("合成一覧").Range("D1048576").End(xlUp).Offset(1)
Dim i As Integer
For i = 10 To 最終列
セル.Offset(i - 10, 0).Value = "その他"
セル.Offset(i - 10, 1).Value = Worksheets("見積書").Cells(12, i).Value
セル.Offset(i - 10, 2).Value = Worksheets("見積書").Cells(13, i).Value
セル.Offset(i - 10, 5).Value = Worksheets("見積書").Cells(14, i).Value
セル.Offset(i - 10, 6).Value = Worksheets("見積書").Cells(15, i).Value
Next
Dim 配合数 As Integer
配合数 = (Range("C1048576").End(xlUp).Row - 11) / 4
If 配合数 >= 2 Then
Dim j As Integer
For j = 2 To 配合数
Set セル = Worksheets("合成一覧").Range("A1048576").End(xlUp).Offset(1)
Range("E3").Copy
セル.Resize(数).PasteSpecial xlPasteValuesAndNumberFormats
Range("E4").Copy
セル.Offset(0, 1).Resize(数).PasteSpecial xlPasteValuesAndNumberFormats
Range("C8").Copy
セル.Offset(0, 2).Resize(数).PasteSpecial xlPasteValuesAndNumberFormats
If Range("C15").Value <> "" Then
セル.Offset(0, 3).Value = "モノマー"
セル.Offset(0, 4).Value = Worksheets("見積書").Range("C12").Value
セル.Offset(0, 5).Value = Worksheets("見積書").Range("C13").Value
セル.Offset(0, 6).Value = Worksheets("見積書").Range("C7").Value
セル.Offset(0, 7).Value = (100 - Worksheets("見積書").Range("G14").Value) * Worksheets("見積書").Cells(j * 4 + 10, 3).Value
セル.Offset(0, 8).Value = Worksheets("見積書").Cells(j * 4 + 11, 3).Value _
* 10 ^ 3 * (1000 / Worksheets("見積書").Range("C8").Value) / Worksheets("見積書").Range("C13").Value
セル.Offset(0, 9).Value = Worksheets("見積書").Cells(j * 4 + 11, 3).Value
End If
If Range("D15").Value <> "" Then
セル.Offset(1, 3).Value = "モノマー"
セル.Offset(1, 4).Value = Worksheets("見積書").Range("D12").Value
セル.Offset(1, 5).Value = Worksheets("見積書").Range("D13").Value
セル.Offset(1, 6).Value = Worksheets("見積書").Range("C7").Value
セル.Offset(1, 7).Value = (100 - Worksheets("見積書").Range("G14").Value) * Worksheets("見積書").Cells(j * 4 + 10, 4).Value
セル.Offset(1, 8).Value = Worksheets("見積書").Cells(j * 4 + 11, 4).Value _
* 10 ^ 3 * (1000 / Worksheets("見積書").Range("C8").Value) / Worksheets("見積書").Range("D13").Value
セル.Offset(1, 9).Value = Worksheets("見積書").Cells(j * 4 + 11, 4).Value
End If
Set セル = Worksheets("合成一覧").Range("D1048576").End(xlUp).Offset(1)
If Range("G15").Value <> "" Then
セル.Value = "架橋剤"
セル.Offset(0, 1).Value = Worksheets("見積書").Range("G12").Value
セル.Offset(0, 2).Value = Worksheets("見積書").Range("G13").Value
セル.Offset(0, 3).Value = Worksheets("見積書").Range("C7").Value
セル.Offset(0, 4).Value = Worksheets("見積書").Range("G14").Value
セル.Offset(0, 5).Value = Worksheets("見積書").Range("G15").Value * 10 ^ 3 * (1000 / Worksheets("見積書").Range("C8").Value) / Worksheets("見積書").Range("G13").Value
セル.Offset(0, 6).Value = Worksheets("見積書").Range("G15").Value
End If
Set セル = Worksheets("合成一覧").Range("D1048576").End(xlUp).Offset(1)
For i = 10 To 最終列
セル.Offset(i - 10, 0).Value = "その他"
セル.Offset(i - 10, 1).Value = Worksheets("見積書").Cells(12, i).Value
セル.Offset(i - 10, 2).Value = Worksheets("見積書").Cells(13, i).Value
セル.Offset(i - 10, 5).Value = Worksheets("見積書").Cells(14, i).Value
セル.Offset(i - 10, 6).Value = Worksheets("見積書").Cells(15, i).Value
Next
Next
End If
Range("E4").Value = Range("E4").Value + 1
MsgBox "配合数:" & 配合数
Exit Sub
エラー処理:
MsgBox Err.Description
End Sub
- 以上です。最後までご覧いただきありがとうございました~!
[http://
:title]