日毎販売金額と販売種別計
7/20 「エクセルのマクロとVBAがみるみるわかる本」日ごと集計をアレンジしたもの
注意 \t を 全角スペース2個で表示
------------(日毎販売金額と販売種別計.vba)----------------------
Sub 日毎販売金額()
Dim まとめsheet As Worksheet
Dim データsheet As Worksheet
Dim 日付 As Date
Dim 商品別 As String
Dim 検索rng, 検索rng2 As Range
Dim 合計rng, 合計rng2 As Range
Dim i As Integer
Dim 最終行, 最終行2 As Integer
Dim 日毎合計, 数量 As Long
Set まとめsheet = ThisWorkbook.Worksheets("まとめ")
Set データsheet = ThisWorkbook.Worksheets("データ")
Set 検索rng = データsheet.Columns(1)
Set 合計rng = データsheet.Columns(5)
Set 検索rng2 = データsheet.Columns(2)
Set 合計rng2 = データsheet.Columns(3)
最終行 = まとめsheet.Cells(まとめsheet.Rows.Count, 1).End(xlUp).Row
最終行2 = まとめsheet.Cells(まとめsheet.Rows.Count, 3).End(xlUp).Row
For i = 2 To 最終行
日付 = まとめsheet.Cells(i, 1)
日毎合計 = Application.WorksheetFunction.SumIf(検索rng, 日付, 合計rng)
まとめsheet.Cells(i, 2) = 日毎合計
Next i
For i = 6 To 最終行2
商品別 = まとめsheet.Cells(i, 3)
数量 = Application.WorksheetFunction.SumIf(検索rng2, 商品別, 合計rng2)
まとめsheet.Cells(i, 4) = 数量
Next i
End Sub
------------(日毎販売金額と販売種別計.vba)----------------------
データの一部
実行前
実行後
上記サンプルシート
証明用差込み印刷
4/24 社内研修受講・参加証明書差込み印刷マクロVBA
注意 \t を 全角スペース2個で表示
--------------(sasi_prn.vba)-----------------------------
Sub print1()
'
' Macro1 Macro 社内研修受講・参加証明差し込み印刷マクロ sasi_prn.vba
'
Dim last1, y, z As Integer
Dim nm1, nm2 As String
z = 0
last1 = Worksheets("出欠表").Range("a2").End(xlDown).Row
For y = 2 To last1
Worksheets("出欠表").Activate
If Cells(y, 9) = 1 Then
z = z + 1
nm1 = Cells(y, 5)
nm2 = Cells(y, 3)
If nm2 = "名古屋" Then
nm2 = nm2 & "営業所"
End If
If nm2 = "三重" Then
nm2 = nm2 & "営業所"
End If
Worksheets("様式5").Activate
Cells(9, 3) = nm1
Cells(10, 3) = nm2
Cells(28, 7) = z
Cells(31 + z, 1) = z
Cells(31 + z, 2) = nm1
Cells(31 + z, 3) = nm2
' ActiveSheet.PrintOut ' 差込み用印刷
End If
Next y
End Sub
--------------(sasi_prn.vba)-----------------------------
データ要素にラベル
1/22 サンプルコード(データ要素にラベルをつける)VBA
--------------(データ要素にラベル)-----------------------------
Sub AttachLabelsToPoints()
'Dimension variables.
Dim Counter As Integer, ChartName As String, xVals As String
' Disable screen updating while the subroutine is run.
Application.ScreenUpdating = False
'Store the formula for the first series in "xVals".
xVals = ActiveChart.SeriesCollection(1).Formula
'Extract the range for the data from xVals.
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
'Attach a label to each data point in the chart.
For Counter = 1 To Range(xVals).Cells.Count
ActiveChart.SeriesCollection(1).Points(Counter).HasDataLabel = _
True
ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text = _
Range(xVals).Cells(Counter, 1).Offset(0, -1).Value
Next Counter
End Sub
--------------(データ要素にラベル)-----------------------------