VBA100本ノック 3本目:セルの消去
出題内容
画像のように1行目に見出し、A列に№が入っています。
№行数およびデータ行数は毎回変化します。
この表の見出し(1行目)と№(A列)を残して、データ部分のみ値を消去してください。
自分の回答
Range("A1").CurrentRegion.Offset(1,1).ClearContents
解説
Offsetを使用すれば出題内容はクリアできるが、消去範囲がズレる。
IntersectやResizeを使用することで、消去範囲のズレを調整できる。
Intersectメソッド
Intersect(Range("A1").CurrentRegion,Range("A1").CurrentRegion.Offset(1,1)).ClearContents
Resizeプロパティ
Range("A1").CurrentRegion.Offset(1, 1).Resize(.Rows.Count - 1,
.Columns.Count - 1).ClearContents
棚卸とは
実地棚卸をしないとわからないこと
棚卸の目的
棚卸の目的は「利益の確定」と「数量管理」
月末数量を確定させることで売上原価を算出し利益を確定させる。(不明ロスが発覚することもある)
また、不要に在庫を抱えすぎていないか不良在庫がないか、システムと数量が一致しているかを確認する。
修正が必要な例
理論上の在庫 | 実際の在庫 |
---|---|
りんご×1 | りんご×2 |
なし×2 | 腐ったなし×2 |
みかん×5 | みかん×1 |
実地棚卸と帳簿棚卸の違い
実地棚卸:実際にそこにある在庫を調べる。
帳簿棚卸:帳簿上での出入りから在庫数を推測する。
帳簿棚卸は理論値(あるべき在庫)で棚卸を行うことになり、実際に存在するか保証することができない。
実地棚卸を行うことで、商品の数量や状態を実際に確認し集計することで売上原価の正確性を担保することができる。
売上原価の求め方
売上原価とは
製品Aを1個製造する為の材料:材料B×1
製品Aを10個販売した場合の材料使用量は…?
「販売数=材料使用数」とは考えない。
月初材料数+当月材料購入数-月末材料数=使用材料数と求める。
実際に計算すると、製品に使う10個よりも多く消費されていることもある。
在庫は粉飾に使われやすい
売上を利用した粉飾
実態のない売上を計上することで、売上を積み上げることで利益が出ているように見せかけることができる。ただし最終的に入金されることがない為いずれ発覚する。
在庫を利用した粉飾
販売数に対応し在庫が使用されていけば売上原価として費用が計上されていく。
月末に在庫を確定させる時に、「在庫数を多く計上する」又は「単価を高く評価する」ことで売上原価を小さくすることができる。
【在庫数を多くする】10個→20個
不明ロスが無かったことになり、使用数量が減少した。
→売上原価減少
【単価を操作する】
使用材料金額が減少した。
→売上原価減少
逆のことを行うと、売上原価が増加する。
→利益が減少
→課税所得が減少
→脱税
作成したフォルダに保存
Sub test()
Dim openBook As Workbook
Dim strPath As String '作成したいフォルダのパス
'①処理後フォルダ作成
'=========================================================
'--- 同じ階層に「処理後」というフォルダを作成する ---'
strPath = ThisWorkbook.Path & "\処理後"
'--- フォルダが存在しない場合のみMkDirで作成 ---'
If (Dir(strPath, vbDirectory) = "") Then
Call MkDir(strPath)
Else
MsgBox "フォルダ作成済みです。確認してください。"
Exit Sub
End If
'②ファイルを選択して加工
'=========================================================
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "開くブックを選んでください"
.Filters.Clear
.Filters.Add "Excelブック", "*.xls?"
.AllowMultiSelect = False
.Show'キャンセルの場合
On Error GoTo Errmsg'ブックを開き、変数に格納
Set openBook = Workbooks.Open(.SelectedItems(1))
End With
'処理
MsgBox openBook.Name & "を開きました。ブックを閉じます。"
'保存場所を指定
'=========================================================
'③作成した[処理後フォルダ]にコピーして保存
openBook.SaveAs (ThisWorkbook.Path & "\処理後\" & ActiveWorkbook.Name)
'開いたブックを閉じる
openBook.Close
Exit Sub
Errmsg:
MsgBox "中止しました"
End Sub
①処理後フォルダ作成
マクロブックと同じ階層に「処理後」という名前のフォルダを作成する
既にフォルダがある場合は処理を中止する。
(フォルダを削除してから再実行させる)
②ファイルを選択して加工
ダイアログを表示させてファイルを選択させる。
開いたファイルはopenBookに格納する。
openBookに対して処理を行う。
③作成した[処理後フォルダ]にコピーして保存
②で開いたopenBookを①で作成した処理後フォルダにコピーして保存する。
openBook自体は保存せずに閉じる。
加工後同じ階層にコピーして保存
Sub 同じ階層に保存()
Dim openBook As Workbook
Dim openPath As String'選択したブック名を格納
openPath = Application.GetOpenFilename("xls,*.xls?")
If openPath <> "False" Then'格納したブックを開く
Set openBook = Workbooks.Open(openPath)'マクロブックと同じ階層に保存
openBook.SaveAs (ThisWorkbook.Path & ActiveWorkbook.Name)openBook.Close savechanges:=True
MsgBox "完了しました"Else
MsgBox "中止します"
End If
End Sub
同じ階層にフォルダを作成する(Mkdir)
Sub フォルダ作成()
'--- 作成したいフォルダのパス ---'
Dim strPath As String
strPath = ThisWorkbook.Path & "¥処理後"
'--- フォルダが存在しない場合のみMkDirで作成 ---'
If (Dir(strPath, vbDirectory) = "") Then
Call MkDir(strPath)
Else
MsgBox "フォルダ作成済みです。確認してください。"
End If
End Sub
Do Loopステートメント(繰り返し処理)
指定した条件で処理を繰り返す
A列の2行目以下の数字を合計する。
While条件(条件が正しい間)
Sub test2()
Dim i As Long
Dim c As Long
i = 2
'空白ではない間処理を続ける
Do While Cells(i, 1) <> ""
c = c + Cells(i, 1)
i = i + 1
LoopMsgBox c
End Sub
Until条件(条件が正しくない間)
Sub test2()
Dim i As Long
Dim c As Long
i = 2
'空白ではない間処理を続ける
Do While Cells(i, 1) <> ""
c = c + Cells(i, 1)
i = i + 1
LoopMsgBox c
End Sub