[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『小計累計マクロ』（kysj）
A B C D E F G H I
7 月 日 摘要 番号 収入 支出 残額 預託 保管
8 4 1 繰越金 1 10 10 10 0
9 2 ○○○ 2 2 8 8 0
10 3 ○○○ 3 3 5 5 0
11 5 1 ○○○ 4 1 4 4 0
12 5 ○○○ 5 2 2 2 0
13 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
14 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
上図を4月は小計のみ2行、5月以降は小計累計3行挿入して下表のようなマクロはできますか？
A B C D E F G H I
7 月 日 摘要 番号 収入 支出 残額 預託 保管
8 4 1 繰越金 1 10 10 10 0
9 2 ○○○ 2 2 8 8 0
10 3 ○○○ 3 3 5 5 0
11 A〜Dの左下から右上への赤斜線 −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−赤罫線 12 4月計 10 5 5 5 0 ========================================================================赤二重罫線 13 5 1 ○○○ 4 1 4 4 0
14 5 ○○○ 5 2 2 2 0
15 A〜Dの左下から右上への赤斜線 −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−赤罫線 16 5月計 0 3 -3 -3 0
17 累計 10 8 2 2 0 ========================================================================赤二重罫線 18 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
19 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
よろしくお願いします。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
結果は別シートに表示します。 結果をSheet2に表示するので Sheet2を事前に作っておいてください。
元の表があるシートをアクティブにして実行して下さい。
'------ Sub 小計累計() Dim i As Long, ii As Long, mxr As Long, Mnt As Long, rr As Long Dim Cnt As Long Dim tbl As Variant, x As Variant, y As Variant, r As Variant, z As Variant
tbl = Range("A8:I" & Range("B" & Rows.Count).End(xlUp).Row + 1).Value
Mnt = Application.Count(Range("A:A"))
ReDim x(1 To 1, 1 To 9)
ReDim y(1 To 1, 1 To 9)
ReDim z(1 To Mnt)
ReDim r(1 To UBound(tbl, 1) + Mnt * 3, 1 To 9)
y(1, 3) = "累計"
For i = 1 To UBound(tbl, 1) - 1
If tbl(i, 1) <> "" Then
ReDim x(1 To 1, 1 To 9)
Cnt = Cnt + 1
x(1, 3) = tbl(i, 1) & "月計"
End If
x(1, 5) = x(1, 5) + tbl(i, 5)
x(1, 6) = x(1, 6) + tbl(i, 6)
x(1, 7) = x(1, 7) + tbl(i, 5) - tbl(i, 6)
If tbl(i, 5) <> "" Then
x(1, 8) = x(1, 8) + tbl(i, 8)
x(1, 9) = x(1, 9) + tbl(i, 9)
Else
x(1, 8) = x(1, 8) - tbl(i - 1, 8) + tbl(i, 8)
x(1, 9) = x(1, 9) - tbl(i - 1, 9) + tbl(i, 9)
End If
rr = rr + 1
For ii = 1 To UBound(tbl, 2)
r(rr, ii) = tbl(i, ii)
Next
If tbl(i + 1, 1) <> "" Or tbl(i + 1, 2) = "" Then
z(Cnt) = rr + 1
For ii = 5 To UBound(y, 2)
y(1, ii) = y(1, ii) + x(1, ii)
Next
rr = rr + 2
For ii = 1 To UBound(tbl, 2)
r(rr, ii) = x(1, ii)
Next
If Cnt > 1 Then
rr = rr + 1
For ii = 1 To UBound(tbl, 2)
r(rr, ii) = y(1, ii)
Next
End If
End If
Next
With Sheets("Sheet2")
.Cells.Clear
Range("A1:I7").Copy .Range("A1")
.Range("A8").Resize(rr, 9).Value = r
For i = 1 To Cnt
With .Range("A" & z(i) + 7)
With .Resize(, 4)
.Merge
With .Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Color = -16776961
.Weight = xlThin
End With
End With
With .Offset(1).Resize(IIf(i = 1, 1, 2), 9)
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = -16776961
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Color = -16776961
.Weight = xlThick
End With
End With
End With
Next
.Select
End With
End Sub
'------
（HANA） 2014/04/30(水) 11:15
あらら。。。 どこの行で止まりますか？ メッセージが出た後「デバッグ」を押すと どこかの行が黄色くハイライトされると思いますが。
ちなみに、標準モジュールに書いてもらいましたか？ （HANA） 2014/04/30(水) 15:45
その前の二つの行は実行されていますね？
すると、エラーが出ているのは 「tbl(i, 5)」や「tbl(i, 6)」ではなく 「x(1, 7)」の部分だと思われますが 「ReDim x(1 To 1, 1 To 9)」としてあるので、ここでエラーとも思えません。
行が黄色くハイライトされているとき、x や tbl と書かれている部分に マウスポインタを近づけてしばらく待ってください。
すると、どれかで「インデックスが有効範囲にありません。」と表示されると思います。 どの部分で表示されるか 教えてください。 （HANA） 2014/04/30(水) 21:04
でしたら、メッセージは 「型が一致しません」 ではないですか？
↓でやってみてもらうとどうですか？ '------ Sub 小計累計2() Dim i As Long, ii As Long, mxr As Long, Mnt As Long, rr As Long Dim Cnt As Long Dim tbl As Variant, x As Variant, y As Variant, r As Variant, z As Variant
tbl = Range("A8:I" & Range("B" & Rows.Count).End(xlUp).Row + 1).Value
Mnt = Application.Count(Range("A:A"))
ReDim x(1 To 1, 1 To 9)
ReDim y(1 To 1, 1 To 9)
ReDim z(1 To Mnt)
ReDim r(1 To UBound(tbl, 1) + Mnt * 3, 1 To 9)
y(1, 3) = "累計"
For i = 1 To UBound(tbl, 1) - 1
If tbl(i, 1) <> "" Then
ReDim x(1 To 1, 1 To 9)
Cnt = Cnt + 1
x(1, 3) = tbl(i, 1) & "月計"
End If
x(1, 5) = x(1, 5) + Val(tbl(i, 5))
x(1, 6) = x(1, 6) + Val(tbl(i, 6))
x(1, 7) = x(1, 7) + Val(tbl(i, 5)) - Val(tbl(i, 6))
If tbl(i, 5) <> "" Then
x(1, 8) = x(1, 8) + Val(tbl(i, 8))
x(1, 9) = x(1, 9) + Val(tbl(i, 9))
Else
x(1, 8) = x(1, 8) - Val(tbl(i - 1, 8)) + Val(tbl(i, 8))
x(1, 9) = x(1, 9) - Val(tbl(i - 1, 9)) + Val(tbl(i, 9))
End If
rr = rr + 1
For ii = 1 To UBound(tbl, 2)
r(rr, ii) = tbl(i, ii)
Next
If tbl(i + 1, 1) <> "" Or tbl(i + 1, 2) = "" Then
z(Cnt) = rr + 1
For ii = 5 To UBound(y, 2)
y(1, ii) = y(1, ii) + x(1, ii)
Next
rr = rr + 2
For ii = 1 To UBound(tbl, 2)
r(rr, ii) = x(1, ii)
Next
If Cnt > 1 Then
rr = rr + 1
For ii = 1 To UBound(tbl, 2)
r(rr, ii) = y(1, ii)
Next
End If
End If
Next
With Sheets("Sheet2")
.Cells.Clear
Range("A1:I7").Copy .Range("A1")
.Range("A8").Resize(rr, 9).Value = r
For i = 1 To Cnt
With .Range("A" & z(i) + 7)
With .Resize(, 4)
.Merge
With .Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Color = -16776961
.Weight = xlThin
End With
End With
With .Offset(1).Resize(IIf(i = 1, 1, 2), 9)
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = -16776961
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Color = -16776961
.Weight = xlThick
End With
End With
End With
Next
.Select
End With
End Sub
'------
（HANA） 2014/04/30(水) 22:04
ローカルウィンドウを表示させて Mnt と rrの値がいくつになっているか [+]tbl と [+]r の型がどのようになっているか Variant/Variant(1 to 12, 1 to 9) ←こんな記述があると思います。 教えてください。 （HANA） 2014/04/30(水) 22:26
すいません、ローカルウィンドウの表示にさえ時間がかかってしまう素人なもので、…。
よろしくお願いします。
（kysj） 2014/04/30(水) 23:07
大丈夫です。 ただ、今日はパソコンの電源を落としてしまったので、とりあえず ReDim r(1 To UBound(tbl, 1) + Mnt * 3, 1 To 9) の*3を*4にしてみて下さい。
結果をみたら、問題点がみつかるかもしれません。
ちなみに、データ数が129件で 月数が2ヶ月 ですよね。 最初にサンプルデータをのせてもらってますが それ以外に何かデータが入っている所があったりしますか？ （HANA） 2014/04/30(水) 23:46
すみません。 *3→*4 では少ないかもしれないので ReDim r(1 To UBound(tbl, 1) * 4, 1 To 9) にしてみて下さい。
また、こちらでは 最初のにのせてもらっている表をコピーして エクセルに 形式を選択して貼り付け。 セル番地を整えたものを使って、製作・テストをしています。
そちらでも一端試して貰って、実際のデータと違う部分がないか （すこしずつ、実際のデータに近づけながら） 確認してみて貰えると良いのですが。 （HANA） 2014/05/01(木) 00:01
エラーで止まらず、最後まで進んだのは、コードが修正できたからではないです。 原因は特定しないといけないと思います。
＞月計累計のH列(預託)がG列(残額)とイコールではありません。 ご呈示の例では一致していると思いますので、うまくいかなくなるサンプルデータを 載せてもらえますか？
いまいち、どの様に計算するのかよくわからないので 計算方法も教えてもらえると良いのですが。
また ＞元表のセルの書式に忠実にできないでしょうか。 これは、元表のセルの書式がどのようなものか見えないので。。。 どの様な書式になっているのでしょう？ （HANA） 2014/05/01(木) 17:20
元表のセルの列、幅、フォント、表示形式などをすべてどう説明すればいいのでしょうか。
何か良い方法はありませんか。
（kysj） 2014/05/01(木) 20:02
＞収入-支出=残額(=預託)ということです では、G列(残額)とH列(預託)は必ず同じ値で I列(保管)は必ず「0」 って事でしょうか？ でしたら、考える事が減るのですが。
＞月計累計のH列(預託)がG列(残額)とイコールではありません。 最初に載せておられるのと違うパターンのデータがあるのではないかと思います。 そのデータをご提示ください。（もちろん、サンプルデータで良いですので。）
ちなみに、これらのデータは 取り込んだorエクセル以外からコピペした ものでしょうか？ それとも、計算式等が入っていて 都度入力をしているものでしょうか？ なるべくこちらでも同じブックが作れる様に（書式などは一旦良いですが） ご説明いただけたらと思います。 ・・・どこにどの様な数式が入っているか・・・等
＞元表のセルの列、幅、フォント、表示形式などをすべてどう説明すればいいのでしょうか。 このご説明で、少し方針を変えてみようと思います。 次回コード変更時に反映させますので 結果を見て良いのか駄目なのか 教えてもらえたらと思います。
まずは、そちらでためしてみて エラーが出るデータ・結果がおかしくなるデータ を確認し、こちらに載せてもらえたらと思います。 （HANA） 2014/05/02(金) 08:22
印刷ﾀｲﾄﾙ $1:$7
A8〜A135 B8〜B135 D8〜D135 E8〜E135 F8〜F135 G8〜G135 H8〜H135 I8〜I135
数値桁区切り-1234、標準中央揃え、MSP明朝11P
C8〜C135 標準、標準中央揃え縮小して全体を表示する、MSP明朝11P
A7〜I135 一番細い罫線格子
A8 =IF(出納!B13=0,"",MONTH(出納!B13))
A9〜 =IF(OR(出納!B14=0,MONTH(出納!B13)=MONTH(出納!B14)),"",MONTH(出納!B14))
B8〜 =IF(出納!B13=0,"",DAY(出納!B13))
C8〜 =IF(AND(出納!D13=0,出納!E13=0),"",IF(OR(出納!C13="繰 越 金",AND(出納!C13="雑 収 入",出納!D13="")),出納!E13,TEXT(出納!E13,"g/標準")&"（"&TEXT(出納!D13,"g/標準")&"）"))
D8〜 =IF(出納!A13=0,"",出納!A13)
E8〜 =IF(出納!F13=0,"",出納!F13)
F8〜 =IF(出納!G13=0,"",出納!G13)
G8〜 =出納!H13
H8〜 =出納!H13
I8〜 =IF(出納!A13=0,"",0)
7行目までは行列の幅以外ｺﾋﾟｰされているようです。
G列(残額)とH列(預託)は必ず同じ値でI列(保管)は必ず「0」ということです。
よろしくお願いします。
（kysj） 2014/05/02(金) 10:50
出納の方のデータも教えてもらってよいですか？ どうせマクロで処理するなら、そちらから攻めて行った方がよさそうに思いますので。 （HANA） 2014/05/02(金) 11:05
よろしくお願いします。
（kysj） 2014/05/02(金) 11:45
うまくいくかどうか試してみてもらえますか？ 今度は、Sheet1を直接変更するので、コピーしてテストして下さい。
'------
Sub 小計累計3()
Dim i As Long, ii As Long
Dim mxr As Long, rr As Long
Dim Cnt As Long
Dim tbl As Variant, x As Variant, y As Variant, r As Variant, z As Variant
ReDim x(1 To 1, 1 To 9)
ReDim y(1 To 1, 1 To 9)
ReDim z(1 To 12, 1 To 2)
With Sheets("出納")
tbl = .Range("A13:H" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Value
End With
ReDim r(1 To UBound(tbl, 1) + 12 * 3, 1 To 9)
Do
Do
i = i + 1
rr = rr + 1
If z(Cnt + 1, 1) = Empty Then
r(rr, 1) = Month(tbl(i + 1, 2))
End If
r(rr, 2) = Day(tbl(i, 2))
If tbl(i, 3) = "繰 越 金" Or (tbl(i, 3) = "雑 収 入" And tbl(i, 4) = "") Then
r(rr, 3) = tbl(i, 5)
Else
r(rr, 3) = tbl(i, 5) & "（" & tbl(i, 4) & "）"
End If
r(rr, 4) = tbl(i, 1)
r(rr, 5) = tbl(i, 6)
r(rr, 6) = tbl(i, 7)
r(rr, 7) = tbl(i, 8)
r(rr, 8) = r(rr, 7)
r(rr, 9) = 0
x(1, 5) = x(1, 5) + tbl(i, 6)
x(1, 6) = x(1, 6) + tbl(i, 7)
x(1, 7) = x(1, 5) - x(1, 6)
x(1, 8) = x(1, 7)
x(1, 9) = 0
z(Cnt + 1, 1) = z(Cnt + 1, 1) + 1
Loop Until Month(tbl(i, 2)) <> Month(tbl(i + 1, 2)) Or tbl(i + 1, 2) = ""
Cnt = Cnt + 1
z(Cnt, 2) = rr
y(1, 5) = y(1, 5) + x(1, 5)
y(1, 6) = y(1, 6) + x(1, 6)
y(1, 7) = y(1, 7) + x(1, 7)
y(1, 8) = y(1, 8) + x(1, 8)
y(1, 9) = y(1, 9) + x(1, 9)
rr = rr + 2
r(rr, 3) = Month(tbl(i, 2)) & "月計"
r(rr, 5) = x(1, 5)
r(rr, 6) = x(1, 6)
r(rr, 7) = x(1, 7)
r(rr, 8) = x(1, 8)
r(rr, 9) = x(1, 9)
If Cnt > 1 Then
rr = rr + 1
r(rr, 3) = "累計"
r(rr, 5) = y(1, 5)
r(rr, 6) = y(1, 6)
r(rr, 7) = y(1, 7)
r(rr, 8) = y(1, 8)
r(rr, 9) = y(1, 9)
End If
ReDim x(1 To 1, 1 To 9)
Loop Until tbl(i + 1, 2) = ""
With Sheets("Sheet1")
With .Rows("8:" & Rows.Count)
.ClearContents
.Borders(xlDiagonalUp).LineStyle = xlLineStyleNone
.Borders.LineStyle = xlLineStyleNone
.MergeCells = False
End With
.Range("A8").Resize(rr, 9).Value = r
.Range("A8").Resize(rr, 9).Borders().Weight = xlHairline
For i = 1 To Cnt
With .Range("A" & z(i, 2) + 8)
With .Resize(, 4)
.Merge
With .Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Color = -16776961
.Weight = xlThin
End With
End With
With .Offset(1).Resize(IIf(i = 1, 1, 2), 9)
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = -16776961
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Color = -16776961
.Weight = xlThick
End With
End With
End With
Next
End With
End Sub
'------
（HANA） 2014/05/02(金) 15:21
（kysj） 2014/05/02(金) 16:23
＞Sheet1の月欄に12(5月の5と出てほしい)と出ちゃっています。(4月は4と出てます) どんなデータでためしていますか？ 最初に載せて下さっている様に、出納シートのデータのサンプルを載せて下さい。
＞月計累計の配置 右詰め(5ｲﾝﾃﾞﾝﾄ) ＞赤斜罫線を赤斜直線0.75ptに変更 をマクロの記録にとって、コードをこちらに貼りつけてもらえますか？
＞格子罫線を名前行を含めて33行1ﾍﾟｰｼﾞでｺﾋﾟｰ(空白行も含めてｺﾋﾟｰ) 「名前行」ってのは、どこの事ですか？ たとえば、17行目が最後の「累計」の行だとすると 罫線がA8:I40の範囲にひかれていたら良いですか？ （HANA） 2014/05/02(金) 16:40
＞月計累計の配置 右詰め(5ｲﾝﾃﾞﾝﾄ)
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 5
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
＞赤斜罫線を赤斜直線0.75ptに変更
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 0.4166929134, _
74.1666929134, 241.25, 98.3333070866).Select
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
Application.CommandBars("Format Object").Visible = False
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 0.75
End With
End Sub
＞たとえば、17行目が最後の「累計」の行だとすると 罫線がA8:I40の範囲にひかれていたら良いですか？ A8:I39です。名前行は7行目のことです。
よろしくお願いします。
（kysj） 2014/05/02(金) 18:48
わかりました。ありがとうございます。 ↓でやってみてもらえますか。
'------
Sub 小計累計4()
Dim i As Long
Dim rr As Long, Cnt As Long
Dim tbl As Variant, r As Variant
Dim x As Variant, y As Variant, z As Variant
Dim MySh As Object
ReDim x(1 To 1, 1 To 9)
ReDim y(1 To 1, 1 To 9)
ReDim z(1 To 12, 1 To 2)
With Sheets("出納")
tbl = .Range("A13:H" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Value
End With
ReDim r(1 To UBound(tbl, 1) + 12 * 3, 1 To 9)
Do
Do
i = i + 1
rr = rr + 1
If z(Cnt + 1, 1) = Empty Then
r(rr, 1) = Month(tbl(i, 2))
End If
r(rr, 2) = Day(tbl(i, 2))
If tbl(i, 3) = "繰 越 金" Or (tbl(i, 3) = "雑 収 入" And tbl(i, 4) = "") Then
r(rr, 3) = tbl(i, 5)
Else
r(rr, 3) = tbl(i, 5) & "（" & tbl(i, 4) & "）"
End If
r(rr, 4) = tbl(i, 1)
r(rr, 5) = tbl(i, 6)
r(rr, 6) = tbl(i, 7)
r(rr, 7) = tbl(i, 8)
r(rr, 8) = r(rr, 7)
r(rr, 9) = 0
x(1, 5) = x(1, 5) + tbl(i, 6)
x(1, 6) = x(1, 6) + tbl(i, 7)
x(1, 7) = x(1, 5) - x(1, 6)
x(1, 8) = x(1, 7)
x(1, 9) = 0
z(Cnt + 1, 1) = z(Cnt + 1, 1) + 1
Loop Until Month(tbl(i, 2)) <> Month(tbl(i + 1, 2)) Or tbl(i + 1, 2) = ""
Cnt = Cnt + 1
z(Cnt, 2) = rr
y(1, 5) = y(1, 5) + x(1, 5)
y(1, 6) = y(1, 6) + x(1, 6)
y(1, 7) = y(1, 7) + x(1, 7)
y(1, 8) = y(1, 8) + x(1, 8)
y(1, 9) = y(1, 9) + x(1, 9)
rr = rr + 2
r(rr, 3) = Month(tbl(i, 2)) & "月計"
r(rr, 5) = x(1, 5)
r(rr, 6) = x(1, 6)
r(rr, 7) = x(1, 7)
r(rr, 8) = x(1, 8)
r(rr, 9) = x(1, 9)
If Cnt > 1 Then
rr = rr + 1
r(rr, 3) = "累計"
r(rr, 5) = y(1, 5)
r(rr, 6) = y(1, 6)
r(rr, 7) = y(1, 7)
r(rr, 8) = y(1, 8)
r(rr, 9) = y(1, 9)
End If
ReDim x(1 To 1, 1 To 9)
Loop Until tbl(i + 1, 2) = ""
With Sheets("Sheet1")
For Each MySh In .Shapes
If MySh.Type = msoLine Then
MySh.Delete
End If
Next
With .Rows("8:" & Rows.Count)
.ClearContents
.Columns(3).ShrinkToFit = True
.Columns(3).HorizontalAlignment = xlGeneral
End With
.Range("A8").Resize(rr, 9).Value = r
.Range("A8").Resize(Application.Ceiling(rr, 32), 9).Borders().Weight = xlHairline
For i = 1 To Cnt
With .Range("A" & z(i, 2) + 8)
'赤斜直線0.75pt
With .Parent.Shapes.AddLine(.Left, .Top + .Height, _
.Offset(, 3).Left + .Offset(, 3).Width, .Offset(, 3).Top).Line
.ForeColor.RGB = RGB(255, 0, 0)
.Weight = 0.75
End With
With .Offset(1).Resize(IIf(i = 1, 1, 2), 9)
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = -16776961
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Color = -16776961
.Weight = xlThick
End With
'右詰(5インデント)
With .Resize(, 1).Offset(, 2)
.HorizontalAlignment = xlRight
.IndentLevel = 5
.ShrinkToFit = False
End With
End With
End With
Next
End With
End Sub
'------
（HANA） 2014/05/02(金) 23:16
（kysj） 2014/05/02(金) 23:48
あ、すみません。
＞C8〜C135 標準、標準中央揃え縮小して全体を表示する、MSP明朝11P 部分ですが、月計・累計行のC列は 一度別の書式にしましたよね。 すると、次に実行したときに もどさないといけないです。
現在は .Columns(3).ShrinkToFit = True .Columns(3).HorizontalAlignment = xlGeneral ・縮小して表示 ・横方向の文字位置は標準 にしてあります。
「中央揃えなのかな？」と思ったりしますので 変更が必要かもしれません。
その他、 ＞C8〜 =IF(AND(出納!D13=0,出納!E13=0),"",IF(OR(出納!C13="繰 越 金",AND(出納!C13="雑 収 入",出納!D13="")),出納!E13,TEXT(出納!E13,"g/標準")&"（"&TEXT(出納!D13,"g/標準")&"）")) の部分はそのままコードにしましたが、 条件を見直せるんじゃないかと思いますが、どうでしょう？ （HANA） 2014/05/03(土) 02:16
＞C8〜C135 標準、標準中央揃え縮小して全体を表示する、MSP明朝11P 部分ですが、月計・累計行のC列は 一度別の書式にしましたよね。 すると、次に実行したときに もどさないといけないです。
出納シートを変更して試してみましたが、二度目のマクロでも前に月計累計行のセルは
縮小されてました。
その他、
＞C8〜 =IF(AND(出納!D13=0,出納!E13=0),"",IF(OR(出納!C13="繰 越 金",AND(出納!C13="雑 収 入",出納!D13="")),出納!E13,TEXT(出納!E13,"g/標準")&"（"&TEXT(出納!D13,"g/標準")&"）")) の部分はそのままコードにしましたが、 条件を見直せるんじゃないかと思いますが、どうでしょう？
C8〜 =IF(AND(出納!D13=0,出納!E13=0),"",IF(D13="",出納!E13,TEXT(出納!E13,"g/標準")&"（"&TEXT(出納!D13,"g/標準")&"）")) でしょうか。
重ね重ねありがとうございます。
（kysj） 2014/05/04(日) 00:11
＞C8〜 =IF(AND(出納!D13=0,出納!E13=0),"",IF(D13="",出納!E13,TEXT(出納!E13,"g/標準")&"（"&TEXT(出納!D13,"g/標準")&"）")) でしょうか。 はい、そんな感じを想像してました。
あとは、くっつける時に TEXT関数を入れてありますが これは何か 入っていないと問題が出るデータがあったりするのでしょうか？ 小計累計4では、直接くっつけているのですが。 （HANA） 2014/05/05(月) 14:14
摘要（収入元・支払先）となりますので、問題ないと思います。
ありがとうございました。
（kysj） 2014/05/05(月) 15:36
D列の入力の有無だけ確認すれば良いのなら
If tbl(i, 3) = "繰 越 金" Or (tbl(i, 3) = "雑 収 入" And tbl(i, 4) = "") Then
部分は
If tbl(i, 4) = "" Then
で良いかと思いますが、どうでしょう？
（HANA） 2014/05/05(月) 16:28
マクロの実行方法の一つに Worksheet_Activate と言うのがあります。
シートモジュールに書くのですが 該当のシートがアクティブになった時 自動的に実行されます。
該当のシートモジュールに
Private Sub Worksheet_Activate()
Call 小計累計4
End Sub
と書いておくと、そのシートがアクティブになった時に 小計累計4 が自動実行されるので
便利かもしれません。
（HANA） 2014/05/07(水) 11:44
A8 =IF(出納!B13=0,"",MONTH(出納!B13))
A9〜 =IF(OR(出納!B14=0,MONTH(出納!B13)=MONTH(出納!B14)),"",MONTH(出納!B14))
↓
A8〜 =IF(OR(出納!B13=0,AND(MOD(ROW(A8),32)<>8,MONTH(出納!B12)=MONTH(出納!B13)),"",MONTH(出納!B13))
このように変更した場合の記述の仕方を教えてください。よろしくお願いします。
（kysj） 2014/05/13(火) 14:46
コード内の
If z(Cnt + 1, 1) = Empty Then
を
If z(Cnt + 1, 1) = Empty Or rr Mod 33 = 0 Then
に変更でどうですか？
（HANA） 2014/05/13(火) 16:27
MOD(ROW(A8),32)<>8→Mod 33 = 0
よろしければ、解説いただけませんか？
（kysj） 2014/05/13(火) 16:45
あ、すみません。違ってますね。 rr Mod 32 = 1 にして下さい。
8行目に MOD(ROW(A1),32)=1 って感じです。 （HANA） 2014/05/13(火) 21:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.