[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロが動作が不安定』（nobu）
web上で探した現金出納帳を改良し、利用しています。
（フリーのシンプルExcel現金出納帳です。）
原版はA〜F列では（６列）
日付 科目 摘要 入金 出金 残高
以下の用に列を増やし利用（A〜I列）（９列）
日付 科目 摘要 内訳 担当 区分 入金 出金 残高
３行目まで見出し行
４行目繰越残高（前月から今月データへ転記）
以下コードにて利用中なのですが繰越（SheetCopy）を実行した時に
前月からの繰越金が転記されない場合があります。
文中にMacro1がありますが、最終行(最終行は月により違います)から下を
一度削除すると不思議に
コードがうまく動作し、転記も可能となります。
識者の方のご指導を頂きたいのですが、何卒よろしくお願いします。
Sub delete_Click()
Dim wGyou As Long
Dim wLastGyou As Long
Dim wSheetName As Variant
'アクティブなシート名を取得
wSheetName = ActiveSheet.Name
'アクティブなセルの行番号を取得
wGyou = ActiveCell.Row
'最終行番号を取得
wLastGyou = Worksheets(wSheetName).UsedRange.Rows.Count
'繰り越し（4行）より上の行または合計欄の行削除は実行しない。
If wGyou <= 4 Or wGyou = wLastGyou Then Exit Sub
'行を削除する
Range(wGyou & ":" & wGyou).Delete
End Sub
Sub insert_Click()
Dim wGyou As Long
'アクティブなセルの行番号を取得
wGyou = ActiveCell.Row
'繰り越し（4行目）より上の行には挿入処理を行わない。
If wGyou < 4 Then Exit Sub
'事前にコピーや切取りの操作を取り消す
Application.CutCopyMode = False
'行を追加
Range(wGyou + 1 & ":" & wGyou + 1).Select
Selection.EntireRow.Insert
'数式をコピーする
Range("I" & wGyou).Copy
Range("I" & wGyou + 1).PasteSpecial Paste:=xlPasteFormulas
'コピーを取り消す
Application.CutCopyMode = False
'セルの位置を移動
Range("A" & wGyou + 1).Select
End Sub
Sub orderby_Click()
Dim wLastGyou As Long
Dim wSheetName As Variant
Dim i As Long
'アクティブなシート名を取得
wSheetName = ActiveSheet.Name
'最終行番号を取得
wLastGyou = Worksheets(wSheetName).UsedRange.Rows.Count
'並べ替えを実行する
Range("A5:I" & wLastGyou - 1).Sort _
Key1:=Range("A5"), _
Order1:=xlAscending, _
Header:=xlNo
'残高の計算式を再セットする
For i = 5 To wLastGyou - 1 '5行目から最終行（合計欄）の1行上まで指定
Range("I" & i).Formula = _
"=IF(OR(G" & i & "<>" & Chr(34) & Chr(34) & ",H" & i & "<>" & Chr(34) & Chr(34) & "),$I$4 +SUM($G$5" & ":G" & i & ")-SUM($H$5" & ":H" & i & ")," & Chr(34) & Chr(34) & ")"
Next i
End Sub
Sub SheetCopy()
Dim wLastGyou As Long
Dim wSheetName As Variant
Dim i As Variant
Dim wMaxDay As Variant
Dim wNextMonth As Variant
Dim wNewSheetName As Variant
Dim wKurikoshi As Long
Call Macro1
'アクティブなシート名を取得
wSheetName = ActiveSheet.Name
'最終行番号を取得
wLastGyou = Worksheets(wSheetName).UsedRange.Rows.Count
'繰り越し金額を取得
wKurikoshi = Range("I" & wLastGyou).Value
'最後の日付を取得（並び替えしていない場合も想定）
For Each i In Range("A5:A" & wLastGyou - 1)
If wMaxDay < i Then wMaxDay = i
Next
'取得した最終日から年月を抽出
If IsDate(wMaxDay) Then
wNextMonth = DateSerial(DatePart("yyyy", wMaxDay), DatePart("m", wMaxDay) + 2, 0)
wNewSheetName = DatePart("yyyy", wNextMonth) & "年" _
& DatePart("m", wNextMonth) & "月"
Else
MsgBox "日付が入力されていないので処理を終了します", _
vbOKOnly + vbExclamation, "エラー"
Exit Sub
End If
'[出納帳]シートをコピーする
Sheets(wSheetName).Copy After:=Sheets(wSheetName)
'コピーしたシート名を変更する
ActiveSheet.Name = wNewSheetName
'繰り越し金額を設定する
Range("I4").Value = wKurikoshi
'A5からE列最終行まで入力された文字をクリアする
Range("A5:H" & wLastGyou - 1).ClearContents
Range("J5:K" & wLastGyou - 1).ClearContents
Range("A1").Value = DateAdd("m", 0, wNextMonth)
End Sub
Sub Macro1()
Rows("76:700").Select
Selection.Delete Shift:=xlUp
End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
私自身、回答案をアップする際に、「手を抜いて」UsedRangeを使った処理を提示したりしますが UsedRangeは、 ・ケースによっては【まぎれ】が少なくなく、現在空白の場所もUsedRangeに含まれることがある。 ・対象領域だと思っている領域の外、ずっと、下のほう、あるいはずっと右のほうのセルに何か（ゴミも含めて）入っていると そこまでがUsedRangeに含まれてしまう。
UsedRangeには、こういう、あぶなっかしさがあります。
wLastGyou = Worksheets(wSheetName).UsedRange.Rows.Count
これを
wLastGyou = Worksheets(wSheetName).Range("A" & Rows.Count).End(xlUp).Row
に変更して試してみるとどうなるでしょうか？
これでも、同じように【不安定】だとすれば、本当に、A列の最終行の下に、なにか目に見えないゴミが 存在するということになります。その場合は、ゴミが残る原因を徹底的に追及しなければいけませんが。
（β） 2015/02/25(水) 21:23
コード全体はまだ精読していませんが、
「最終行の一行のみ残ってしまいます。」や「B４に 繰越残高 タイトルがあるのですが これは、消えてしまいました 」
これは、どのマクロを実行した時にそうなるんですか？
それと、Macro1 以外に４つのプロシジャがありますが、それぞれ、何をどのように処理する意図なのか 具体的に説明いただけませんか。 （ついでに、Macro1の必要性についても）
また、コード内で、ActiveSheet や ActiveCell が登場しますが、各マクロ実行前に、シートやセルを 操作者が選択するんでしょうけど、何を選択するんですか？ また、その意図は？
（β） 2015/02/26(木) 09:42
Range("J5:K" & wLastGyou - 1).ClearContents
この部分で最終行から1行引いた行数をクリアしてということになっています。
最終行は合計欄ということですがそれが残るということです。
'A5からE列最終行まで入力された文字をクリアする
となっていますが実際にはF列からH列 JからK列も削除します
（デイト） 2015/02/26(木) 10:03
（nobu） 2015/02/27(金) 12:57
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.