商品元帳

商品元帳を発行したい期間と商品を選択します。

標準モジュールに記述
Sub 商品元帳()
    frmSmoto.Show
End Sub

フォームモジュールに記述

Private Sub cmdJikkou_Click()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim lastRow As Long
    Dim lastRow1 As Long
    Dim 数量計 As Long
    Dim 売上計 As Long
'商品元帳クリア
    Worksheets("商品元帳").Cells(1, 6) = ""
    Worksheets("商品元帳").Cells(2, 6) = ""
    Worksheets("商品元帳").Cells(2, 3) = ""
    Worksheets("商品元帳").Cells(2, 4) = ""
    lastRow = Worksheets("商品元帳").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To lastRow + 1
        For j = 1 To 7
            Worksheets("商品元帳").Cells(i, j) = ""
        Next
    Next
'入力項目等の表示
    Worksheets("商品元帳").Cells(1, 6) = txtKaisi.Text
    Worksheets("商品元帳").Cells(2, 6) = txtEnd.Text
    Worksheets("商品元帳").Cells(2, 3) = txtScode.Text
    Worksheets("商品元帳").Cells(2, 4) = lblSname.Caption
'明細項目の表示
'作業のクリア
    Worksheets("作業").Cells.Clear
    Worksheets("作業").Cells(1, 1) = "売上伝票No"
    Worksheets("作業").Cells(1, 2) = "売上日"
    Worksheets("作業").Cells(1, 3) = "得意先コード"
    Worksheets("作業").Cells(1, 4) = "得意先名"
    Worksheets("作業").Cells(1, 5) = "数量"
    Worksheets("作業").Cells(1, 6) = "販売単価"
    Worksheets("作業").Cells(1, 7) = "売上金額"
'売上データの取り出し
    lastRow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
    j = 2
    For i = 2 To lastRow
        If Worksheets("売上明細").Cells(i, 2) >= txtKaisi.Text And Worksheets("売上明細").Cells(i, 2) <= txtEnd.Text And Worksheets("売上明細").Cells(i, 5) = txtScode.Text Then
            Worksheets("作業").Cells(j, 1) = Worksheets("売上明細").Cells(i, 1)
            Worksheets("作業").Cells(j, 2) = Worksheets("売上明細").Cells(i, 2)
            Worksheets("作業").Cells(j, 3) = Worksheets("売上明細").Cells(i, 3)
            Worksheets("作業").Cells(j, 4) = Worksheets("売上明細").Cells(i, 4)
            Worksheets("作業").Cells(j, 5) = Worksheets("売上明細").Cells(i, 7)
            Worksheets("作業").Cells(j, 6) = Worksheets("売上明細").Cells(i, 8)
            Worksheets("作業").Cells(j, 7) = Worksheets("売上明細").Cells(i, 9)
            j = j + 1
        End If
    Next
'作業データの並び替え
    lastRow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
    Range(Cells(2, 1), Cells(lastRow, 7)).Select
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 2), SortOn _
        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("作業").Sort
        .SetRange Range(Cells(2, 1), Cells(lastRow, 7))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'合計計算
    For i = 2 To lastRow
        数量計 = 数量計 + Worksheets("作業").Cells(i, 5)
        売上計 = 売上計 + Worksheets("作業").Cells(i, 7)
    Next
    Worksheets("作業").Cells(lastRow + 1, 4) = "合計"
    Worksheets("作業").Cells(lastRow + 1, 5) = 数量計
    Worksheets("作業").Cells(lastRow + 1, 7) = 売上計
'商品元帳に転記
    j = 4
    For i = 2 To lastRow + 1
        For k = 1 To 7
            Worksheets("商品元帳").Cells(j, k) = Worksheets("作業").Cells(i, k)
        Next
        j = j + 1
    Next
    Worksheets("商品元帳").Select
    Unload Me
End Sub
Private Sub cmdCancel_Click()
    Unload Me
End Sub
Private Sub UserForm_Initialize()
    Dim lastRow As Long
    Dim i As Long
    Dim hajime As String
    Dim saigo As String
    lastRow = Worksheets("商品名").Cells(Rows.Count, 1).End(xlUp).Row
    lstSyouhin.ColumnCount = 2
    For i = 2 To lastRow
        With lstSyouhin
            .AddItem
            .List(i - 2, 0) = Worksheets("商品名").Cells(i, 1)
            .List(i - 2, 1) = Worksheets("商品名").Cells(i, 2)
        End With
    Next
'売上明細の始め（期首）と最後（今）を表示する
    lastRow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
    hajime = Worksheets("売上明細").Cells(2, 2)
    saigo = Worksheets("売上明細").Cells(2, 2)
    For i = 2 To lastRow
        If Worksheets("売上明細").Cells(i, 2) < hajime Then
           hajime = Worksheets("売上明細").Cells(i, 2)
        End If
        If Worksheets("売上明細").Cells(i, 2) > saigo Then
           saigo = Worksheets("売上明細").Cells(i, 2)
        End If
    Next
    txtKaisi.Text = hajime
    txtEnd.Text = saigo
End Sub
Private Sub lstSyouhin_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    txtScode = lstSyouhin.Text
    lblSname = lstSyouhin.List(lstSyouhin.ListIndex, 1)
End Sub