自動でセルの数値を変更したい

質問

自動でセルの数値を変更したいのですが、基本的な間違いがあるようで、できません何か別
な解決方法がありませんか、

----------------------------------------------------
Sub 斜線オリジナル3()
'
' 斜線オリジナル3 Macro

Set rngstart = Worksheets("時刻2").Cells(3, 9)

Set rngend = Worksheets("時刻2").Cells(13, 25)

BX = rngstart.Left

BY = rngstart.Top

EX = rngend.Left

EY = rngend.Top

'直線

With ActiveSheet.Shapes.AddLine(BX, BY, EX, EY).Line

End With

End Sub
-------------------------------------------------
このコードは、参考にしたコードを自分が勝手に簡単にしたものです、知識rがあってやったものでは
ありませんのでお許し下さい。理由はわかりませんが、なぜか一応は動作します。（斜線が引かれます。）

以上のコードで、Cells(3,9)　と　Cells(13,25)　の列に相当する、9と25の数値を自動で変えたいのですが、
　for cnt = 10 to 30
a = worksheets("時刻2").cells(3,cnt).value
set rngstart = worksheets("時刻2").cells(3,a)

のようにしたいのですが、エラーがでます。どのようにしたらいいでしょうか、教えて頂けませんか。

回答No.4

eden3616

▼最下のVBAコード(1)と差し換えてください。（添付画像上側が実行結果）

補足のコードのように、以下の(1)(2)だけをループで回して格納し、
ループを出てから一発で(3)(4)で描画のような事はできません(しません)。

(1)セルの値（列番号）を変数に格納する「a、b」
(2)開始・終了基準セルをオブジェクト変数に格納する「rngstart、rngend」
(3)開始・終了基準セルの左上座標を変数に格納する「BX、BY、EX、EY」
(4)格納した座標で直線を描画する

上記(1)～(4)の処理をFor～Nextループ内で処理する必要があります。
また、今回も同じくO10：AI10に15～35の整数値が入力されている必要があります。

▼また、For～Nextにより変動する変数cntの値を直接列番号として使用すれば
VBAコード(2)のように使用することが出来ます。（添付画像下側が実行結果）
この場合、セルの値で列番号を使用しないため3、10行目が空欄でも動作します。

▼VBAコード(3)は、上記以外の方法で作成してみました。
　（実行結果の画像はないですが）
１本目の線を引く範囲を指定し、引く線の本数をコード内の変数に指定することで
１本目から１列右隣のセルに平行線を指定本数引くコードになります。

　>簡単に言えば、B2からL１０セル
　>　　　　　　　C2からM１０セル　
　>　　　　　　　D２からN10セル
　>　　　　　　　E2からO10セル
　>のようにに平行な斜線を引きたいのですが無理でしょうか。

捕捉コメントの上記平行線を描画する場合、
コード内の変数の値を以下のようにしてください。
～～～～～～～～～～～～～～～～～～～～～～
'一本目の描画範囲セル
Set myRng = Range("B2:L10")
'描画する線の数
cnt = 4
～～～～～～～～～～～～～～～～～～～～～～

■VBAコード(1)

Sub 斜線サンプル()
'
' 斜線オリジナル3 Macro

'変数を定義
Dim SP As Object
Dim cnt As Integer
Dim rngstart As Range
Dim rngend As Range
Dim a As Integer
Dim b As Integer

'繰り返し処理
For cnt = 10 To 30
　　　　'変数aにセルの内容を格納
　　　　a = Worksheets("時刻2").Cells(3, cnt).Value
　　　　'変数bにセルの内容を格納
　　　　b = Worksheets("時刻2").Cells(10, cnt + 5).Value
　　　　'基準セルをセルオブジェクトに格納
　　　　Set rngstart = Worksheets("時刻2").Cells(3, a)
　　　　Set rngend = Worksheets("時刻2").Cells(10, b)
　　　　'座標を格納
　　　　BX = rngstart.Left
　　　　BY = rngstart.Top
　　　　EX = rngend.Left
　　　　EY = rngend.Top
　　　　'直線
　　　　Set SP = ActiveSheet.Shapes.AddLine(BX, BY, EX, EY).Line
Next cnt
End Sub

■VBAコード(2)

Sub 斜線サンプル2()
'
' 斜線オリジナル3 Macro

'変数を定義
Dim SP As Object
Dim cnt As Integer
Dim rngstart As Range

'繰り返し処理
For cnt = 10 To 30
　　　　'基準セルをセルオブジェクトに格納
　　　　Set rngstart = Worksheets("時刻2").Cells(3, cnt)
　　　　'座標を格納
　　　　BX = rngstart.Left
　　　　BY = rngstart.Top
　　　　EX = rngstart.Offset(7, 5).Left
　　　　EY = rngstart.Offset(7, 5).Top
　　　　'直線
　　　　Set SP = ActiveSheet.Shapes.AddLine(BX, BY, EX, EY).Line
Next cnt
End Sub

■VBAコード(3)

Sub 斜線サンプル3()
'
' 斜線オリジナル3 Macro

'変数を定義
Dim cnt As Integer
Dim myRng As Range

'一本目の描画範囲セル
Set myRng = Range("B2:L10")
'描画する線の数
cnt = 4

Do Until cnt < 1
　　ActiveSheet.Shapes.AddLine _
　　　　myRng(1).Left, myRng(1).Top, _
　　　　myRng(myRng.Count).Left, myRng(myRng.Count).Top
　　Set myRng = myRng.Offset(0, 1)
　　cnt = cnt - 1
Loop

End Sub

お礼

大変な事をお願いしてしまったと反省しています。
こんなに詳しく検討して頂きありがとうございます。
これから、一日じっくりと勉強させて頂きます。
まずは、受信のお礼まで。

回答No.3

eden3616

>直ちに教えて頂いたコードを実行してみましたが、私がやるとどうしてもエラーが出てしまいます。
>コードは、すべてコピー貼り付けました。

>エラー箇所は、
>　　　　　set rngstart = worksheets("時刻2").Cells(３,a)
>の箇所です。エラー内容は
>、
>　　　　　　　「実行時エラー　1004
>　　　　　　　　　アプリケーション定義またはオブジェクト定義のエラーです。」
>　
>と出ます。これは、今回の質問させて頂きましたときとおなじ箇所、内容です。
>
>Excelのバージョンとか何か原因があるのでしょうか。？

以下の点をご確認ください。

(1)「セルJ3：AD3に入力されている列番号を使用」しています。
前回回答分の添付画像のようにJ3：AD3のセルに静数値で列番号の代わりとなる値は入っていますか？
（空欄の場合、同様のエラーが発生します）
・エラーが発生した際に、コード中の「cnt」にカーソルを合わせれば
　現在(エラー発生時)の変数の内容がツールチップで表示されます。
　10～30の値が代入されているか確認ください。
・変数aの値はシート「時刻2」の3行目の10列目～30列目であるJ3:AD3の値が
　1以上の正数値で代入されているか確認して下さい。

(2)変数cntの値を直接列番号として使用する場合は以下のようになります。
該当部分を差し換えてください。
(目的が違う場合であっても検証のため差替えて動作するか確認下さい)

'繰り返し処理
For cnt = 10 To 30
　　　　'基準セルをセルオブジェクトに格納
　　　　Set rngstart = Worksheets("時刻2").Cells(3, cnt)
　　　　Set rngend = Worksheets("時刻2").Cells(13, 25)
　　　　'座標を格納
　　　　BX = rngstart.Left
　　　　BY = rngstart.Top
　　　　EX = rngend.Left
　　　　EY = rngend.Top
　　　　'直線
　　　　Set SP = ActiveSheet.Shapes.AddLine(BX, BY, EX, EY).Line
Next cnt

お礼

ありがとう御座いました。原因はご指摘のとうりのところでした。
セル（13,25）の位置から左向きの斜線が参照セルの数値に相当したセルに向かって見事に引くことができました。
そこで、本来の目的の、セルの数値を変更して自動で平行な斜線を引くために、rngend部分をつぎの様に変更してみましたが、やはりエラーになってしまいます。私の知識では困難です。
簡単に言えば、B2からL１０セル
　　　　　　　C2からM１０セル　
　　　　　　　D２からN10セル
　　　　　　　E2からO10セル
のようにに平行な斜線を引きたいのですが無理でしょうか。

---------------------------------

Sub 斜線サンプル()
'
' 斜線オリジナル3 Macro

'変数を定義
Dim SP As Object
Dim cnt As Integer
Dim rngstart As Range
Dim rngend As Range
Dim a As Integer

'繰り返し処理
For cnt = 10 To 30
'変数aにセルの内容を格納
a = Worksheets("時刻2").Cells(3, cnt).Value
'基準セルをセルオブジェクトに格納
Set rngstart = Worksheets("時刻2").Cells(3, a)
Next cnt

For cnt1 = 15 To 35
'変数bにセルの内容を格納
b = Worksheets("時刻2").Cells(10, cnt1).Valu
'基準セルをセルオブジェクトに格納
Set rngend = Worksheets("時刻2").Cells(10, b)
Next cnt1

'座標を格納
BX = rngstart.Left
BY = rngstart.Top
EX = rngend.Left
EY = rngend.Top
'直線
Set SP = ActiveSheet.Shapes.AddLine(BX, BY, EX, EY).Line

End Sub
　-----------------------------------
　rngend部分の変更箇所は上記のコードです。

再三のお手数をおかけし申し訳ありませんが、よろしくお願いいたします。

回答No.2

mshr1962

原因は
a = worksheets("時刻2").cells(3,cnt).value
だと思うけど。。。
次の行で、cells(3,a)となってるので
aは1以上の整数である必要がありますが、
cells(3,cnt).valueの内容に文字や空白や1未満の数値はありませんか？

あと、START-ENDの列をどのように変更したいのかが見えません。
それが判らないと、適切な回答は得られないと思いますけど。。。

お礼

お礼の返事が遅くなり申し訳ありません。
ご指摘のとおり参照範囲に間違いがありました。eden3616さんからもご指摘いただきました。
いま、やっと１歩前に進んだところです。
　また、質問内容がはっきりしなかったこと、申し訳ありませんでした。
もっと、勉強したいと思っております。今後ともよろしくお願いします。

回答No.1

eden3616

どこでエラーがでるかぐらいは書きましょう。

あと、具体的にどのようにラインを引きたいのかわかりませんので
追加しようとしたコードを参考にセルJ3：AD3に入力されている列番号を使用して
3行目の各列番号のセル左上とセルY13の左上を結ぶシェイプを作成するようにしています。

Sub 斜線サンプル()
'
' 斜線オリジナル3 Macro

'変数を定義
Dim SP As Object
Dim cnt As Integer
Dim rngstart As Range
Dim rngend As Range
Dim a As Integer

'繰り返し処理
For cnt = 10 To 30
　　'変数aにセルの内容を格納
　　a = Worksheets("時刻2").Cells(3, cnt).Value
　　'基準セルをセルオブジェクトに格納
　　Set rngstart = Worksheets("時刻2").Cells(3, a)
　　Set rngend = Worksheets("時刻2").Cells(13, 25)
　　'座標を格納
　　BX = rngstart.Left
　　BY = rngstart.Top
　　EX = rngend.Left
　　EY = rngend.Top
　　'直線
　　Set SP = ActiveSheet.Shapes.AddLine(BX, BY, EX, EY).Line
Next cnt

End Sub

お礼

早速のご解答ありがとう御座いました。
エラーの出る箇所の説明不足すみませんでした。
直ちに教えて頂いたコードを実行してみましたが、私がやるとどうしてもエラーが出てしまいます。
コードは、すべてコピー貼り付けました。

エラー箇所は、
　　　　　set rngstart = worksheets("時刻2").Cells(３,a)
の箇所です。エラー内容は
、
　　　　　　　「実行時エラー　1004
　　　　　　　　　アプリケーション定義またはオブジェクト定義のエラーです。」

と出ます。これは、今回の質問させて頂きましたときとおなじ箇所、内容です。

Excelのバージョンとか何か原因があるのでしょうか。？
-----------------------------------
シュミレーションして頂いたのを確認しました。まさにこのようにようにしたいのです。後はend部分の数値を自動で変えれば目的の結果が得られます。

お忙しいところ恐縮ですが、もう一度ご検討お願いできますか。