Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

32260 / 76734

←次へ　｜　前へ→


	【49713】Re:2表出力

Hirofumi - 07/6/18(月) 12:13 -


	引用なし

	パスワード

いろいろ数値をいじって上手くいきませんか？
私のコードは、基本的に入出力の位置の変更が簡単に出来る様に書いている積りです
（勘違い、バグでパーフェクトでは有りませんが？）
入力でも出力でも基準のセル位置を決めて、そこからのOffsetで相対的に追っています
これは、入力のList、出力のListを左右に何列か、上下に何行かずらしたい時は、
各基準位置を変更するだけで対応できるという事です

詰まり、今回の様な場合、「部門」シートの表（本店、支店A、支店B）を
1表と考えるか3表と考えるかに因っても対応が変わります

多分、hiroさんがいじった方向は、本店、支店A、支店Bを1つの表と考えて、修正した物と思います
これはどういう事かと言うと、
基準セル位置、

　　'◆累計を転記するシートの基準位置を設定(指定位置の下の行に転記)
　　Set rngOther = Worksheets("部門").Cells(4, "C") '★追加

を変えないで、位置を指定しようとした場合です

この場合、内容は見て居ませんがvntRPosの値は、「07/6/17(日) 23:27」のレスの様に変更すれば善いのでが？、
セルのクリアが邪魔をすると思います（実行する度に本店位置の表がクリアされますので）、
対策案として

クリアをさせない案

「Function AddUp」の中の

　　　　　　　　　　'転記先データを消去
　　　　　　　　　　For j = 0 To UBound(vntClear)
　　　　　　　　　　　　rngOther.Offset(vntClear(j), vntCPos(i)) = Empty
　　　　　　　　　　Next j

　をコメントアウトもしくは、削除する
　
の案が考えられます

また、本店、支店A、支店Bをそれぞれ別な表として捉える場合の修正は、

例えば、本店の基準セル位置（売上目標の前列で本年の上の行）は変わらず、C4とし、
同様に、支店Aの基準セル位置（売上目標の前列で本年の上の行）をC118とし
同様に、支店Bの基準セル位置（売上目標の前列で本年の上の行）をC208とします

部門データの転記行位置を設定を以下の様に変更します

　　'◆部門データの転記行位置を設定
　　'転記先C4セルを基準とし、基準からの行Offsetで指定
　　'例えばE5=1、E8=4、尚転記しない所は""で指定
　　Select Case vntKeyB1
　　　　Case "本店"
　　　　　　'◆累計を転記するシートの基準位置を設定(指定位置の下の行に転記)
　　　　　　Set rngOther = Worksheets("部門").Cells(4, "C")
　　　　　　vntRPos = Array(56, 59, 62, 77, 65, 89, 68, 71, 34, "", _
　　　　　　　　　　　　　　1, 37, "", 16, 19, 4, 22, 25, 40, 43, _
　　　　　　　　　　　　　　86, 46, 7, 10, 28, "", "", 80, "", 92)
　　　　Case "支店A"
　　　　　　'◆累計を転記するシートの基準位置を設定(指定位置の下の行に転記)
　　　　　　Set rngOther = Worksheets("部門").Cells(118, "C")
　　　　　　vntRPos = Array(56, 59, "", "", 68, "", 62, 31, 34, "", _
　　　　　　　　　　　　　　13, 1, "", "", "", "", 16, 19, 47, 4, _
　　　　　　　　　　　　　　"", 50, 37, 7, "", "", "", 22, "", 25)
　　　　Case "支店B"
　　　　　　'◆累計を転記するシートの基準位置を設定(指定位置の下の行に転記)
　　　　　　Set rngOther = Worksheets("部門").Cells(208, "C")
　　　　　　vntRPos = Array("", "", "", "", "", "", "", "", "", 4, _
　　　　　　　　　　　　　　"", "", 1, "", "", "", "", "", "", "", _
　　　　　　　　　　　　　　"", "", "", "", "", "", 7, "", 13, "")
　　End Select

この場合のvntRPosの値は、rngOtherの行位置を0とした行Offsetで表します

次に、セルをクリアする部分が邪魔なので以下の部分を削除します

「Function AddUp」の中の

　　　　　　　　　　'転記先データを消去
　　　　　　　　　　For j = 0 To UBound(vntClear)
　　　　　　　　　　　　rngOther.Offset(vntClear(j), vntCPos(i)) = Empty
　　　　　　　　　　Next j

以上

>最終的にはList2抽出した前年累計値もシート部門の本年累計値の一行下に転記したいと思ってます

これは、2回目の

　　If Not AddUp(rngList, rngResult.Offset(, 10), _
　　　　　　　　rngWork, vntKeyA2, vntKeyB1, clngColumns, _
　　　　　　　　　　　　clngItem, vntItem) Then
　　　　GoTo Wayout
　　End If

に引数、rngOther.Offset(1)、vntCPos、vntRPosを与えればできます

4 hits

▼

【49539】月間集計 hiro 07/6/9(土) 17:35