Master3’s blog

LaTeXやExcelVBAなどの作例集

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]