マクロ罫線枠がある部分のみ左上～右下へナンバリング

質問

以前　http://okwave.jp/qa/q7170027.html　にて右への順方向への
番号付けを教えて頂き、参考になったつもりでしたが、後々良く見ても
未熟な自分が経験していない部分が多くあり、教本にも掲載が無く
ほとんど理解できません。
番号付けの向きを変える場合はどこをイジるんだ？と、あれこれ
やってみますが反応なく、私自身が固まってしまいます（恥。
そこで試しに添付の様に左上～右下へナンバリングするやり方を
教えて頂けませんでしょうか？
今後に生かしたいと罫線に関わらず他にも色んなパターンを集めています。
急いではいませんので、お時間の空いた時にでもお願いします。

回答No.2

keithin · ベストアンサー

前回のご質問では「横向けナンバリング」でしたので，全ての回答者が

sub macro1実験してください()
　dim h,n
　for each h in range("セル範囲")
　　n = n + 1
　　h = n
　next
end sub

タイプの巡回をしました。
for each nextタイプの「巡回方向」は決まっており，変更する方法はありません。

今回ご質問は「縦方向」なので，

方法１）
sub macro2()
　dim c, cs, ce, r, rs, re, n
　cs = range("セル範囲").column
　ce = cs + range("セル範囲").columns.count - 1
　rs = range("セル範囲").row
　re = range("セル範囲").cells(range("セル範囲").count).row

　for c = cs to ce
　　for r = rs to re
　　　n = n + 1
　　　cells(r, c) = n
　　next r
　next c
end sub
のようなカンジで，意図的に縦ループと横ループを廻す必要があります。

方法２）
現在の対象セル範囲をコピーし，どこかの作業場所に「形式を選んで貼り付け」の「行と列を入れ替える」で縦横をひっくり返してやれば，横方向の巡回(前回と同じ向き)で処理が出来ます。
作業完了後，またコピーして元の場所に「行列を入れ替える」で貼り戻してやれば，完成です。

お礼

いつも回答ありがとうございます。
方法１のスマートなコードに感心してしまいますが、これは熟知しきった方だからできる裏技的なコードだと思いますが、少しずつでも解読して理解できるようにします。
方法２を提案されて、「あ！そうだ、この手があった！」と真っ先に飛びつきました（笑。ナンバーは左上スタートの右下エンドなので、左上→右下の線対象の罫線図であれば問題なく使える事になります。実際にやってみてうまくいきました！楽な道を取りますが、とりあえずこれで進めてみようと思います。
また機会がありましたらお願いします。ありがとうございました。

回答No.7

mar00

こちらでは問題なく動作しているので原因はわからないのですが
他の質問の回答した時も似たような事があったので変数名を変えてみてください。
Sfori1、Sforj2、Efori1 Eforj2 の4つです。

お礼

最後までお付き合い下さいましてありがとうございました。
せっかく助言を頂き、また、もう少しかじりたかったのですがそろそろ閉じることにします。それでも時間を作って（皆さんの力作を）アレンジしながら試してみます。ムダにはしません。またの機会にもお力をお貸し下さい。

回答No.6

mar00

インプットボックスで付番を縦方向か横方向か指定するようにしています。
範囲を指定してから実行してください。(大きめでも可)
Sub Macro1()
x = InputBox("作成する方向を指定して下さい。" & Chr(10) & "縦方向: 1" & Chr(10) & "縦方向: 2")
If x = "" Then Exit Sub
If x = 1 Then
Sfori1 = Selection(1).Column
Sforj2 = Selection(1).Row
Efori1 = Selection(Selection.Count).Column
Eforj2 = Selection(Selection.Count).Row
Else
Sfori1 = Selection(1).Row
Sforj2 = Selection(1).Column
Efori1 = Selection(Selection.Count).Row
Eforj2 = Selection(Selection.Count).Column
End If
COUNTER = 0
For i = Sfori1 To Efori1
For j = Sforj2 To Eforj2
If x = 1 Then
If Cells(j, i).Borders.LineStyle <> xlNone Then
COUNTER = COUNTER + 1
Cells(j, i) = COUNTER
End If
Else
If Cells(i, j).Borders.LineStyle <> xlNone Then
COUNTER = COUNTER + 1
Cells(i, j) = COUNTER
End If
End If
Next j
Next i
End Sub

補足

回答ありがとうございます。
私の変数宣言が悪いのか？「実行エラー91：オブジェクト変数またはwithブロック変数が設定されていません」と出ます。実際に確認されての回答だと思いますので、あとこれだけ追加すれば動くよ！というものがありましたらお手数でも追記願えませんでしょうか？。ちなみに（エクセル2007_Ver12.0.6557....）です。
そろそろ解決催促がきますので明日には閉じようと思っています。

回答No.5

tom04

No.4です！
たびたびごめんなさい。

前回のコードを下記に訂正してみてください。

＞For j = 1 To Selection.Columns.Count　を
＞For j = Selection(1).Column To Selection(Selection.Count).Column
に！

＞For i = 1 To Selection.Rows.Count　を
＞For i = Selection(1).Row To Selection(Selection.Count).Row
に！

これでどこで範囲指定しても大丈夫だと思います。

何度も失礼しました。m(_ _)m

お礼

継続回答ありがとうございます。
ANo.４と併せてこちらに書かせて頂きます。
まだまだ未熟な私でももう少しで理解できそうなコードで興味あります。実際にやってみましたら、提示した図のまま（全て１行マス）では問題なく動きましたが、２行にしたり、形を変形させたりすると番号が崩れてしまいます。予め伝えていなかった私が悪いのですが、この図に限らず色んなパターン図で使いますので、もう少しコードを追加する事で完成形になりそうです。せっかく回答下さいましたが、これに懲りずに次回もおつきあい下されば嬉しいです。ありがとうございました。

回答No.4

tom04

こんにちは！
一例です。

Sub test()
Dim i, j, k As Long
For j = 1 To Selection.Columns.Count
For i = 1 To Selection.Rows.Count
If Cells(i, j).Borders.LineStyle = xlContinuous Then
k = k + 1
Cells(i, j) = k
End If
Next i
Next j
End Sub

※　A1セルから範囲指定してマクロを実行してみてください。
＞Selection.Columns.Count　や
＞Selection.Rows.Count

を使っていますので、範囲指定した列数・行数だけしかマクロが走りません。
かなり広めに範囲指定しておいても構いません。

参考になりますかね？m(_ _)m

回答No.3

xls88

keithinさんが言われていることですが
1列毎に縦にループする例です。

Dim cc As Range
Dim c As Range

For Each cc In Range("B2:J10").Columns　'列（横）ループ
For Each c In cc.Cells　'列内で行（縦）ループ
Msgbox c.Address
'仕事
'仕事
'仕事
Next
Next

お礼

継続回答ありがとうございます。
前回お応え頂きました横方向と、今回の縦方向の２種の図が必要となり、罫線図をコピペする必要もありますのでkeithinさん提案の「形式を選んで貼り付け(S)」を候補とさせて頂くことにしました。
せっかく回答頂きましたので、勉強リストに入れさせて頂きます。今後ともよろしくお願いします。ありがとうございました。

回答No.1

bin-chan

http://okwave.jp/qa/q7170027.html　の＃２さんのコードで
> If c.Borders(i).LineStyle = xlNone Then
ここの部分を変更することになります。

でもコード書いちゃうとタメならないので、
「マクロの記録」で「セルの上下左右を罫線で囲む」コードを作成してみてください。

お礼

返答ありがとうございます。
そうなんですよね。
本当はヒントを貰うだけで、自分で解決に持っていきたいところです。
がしかし、秋にマクロを始めてここ３か月位時間が無くてさぼってますのでほとんど忘れてしまったのが事実です（泣
これ！をやりたい、との目標がなく、たま～に必要に応じて過去のものから応用するくらいで、なかなか進歩がありません。また次回、お願いします。