画像のように、行の数字同士をセルの中央で自動で線を結ぶ方法を教えてください。以前、列での同じ数字の例がありましたので、それを行で真似をしてみましたが、うまくいきません。よろしくお願いします。ちなみに下記のようにしたのですが、、、
Sub test()
Range("B9:S11").HorizontalAlignment = xlCenter '中央寄せ
Range("B9:S11") = "=Randbetween(1,18)" '乱数の生成
ActiveSheet.Shapes.SelectAll '既存の図形を選択
Selection.Delete '既存の図形を削除
Dim i As Long, j As Long
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single
For i = 1 To 18 '9行の値の個数分だけ繰り返す
For j = 1 To 18 '一つの9行の値で11行全部を照合
If Cells(i, 1) = Cells(j2) Then '9行の数値と11行の数値が同じなら
x1 = Cells(i, 1).Left + Cells(i, 1).Width / 2 '直線の引き始めの横位置
y1 = Cells(i, 1).Top + Cells(i, 1).Height / 2 '直線の引き始めの縦位置
x2 = Cells(j, 2).Left + Cells(j, 2).Width / 2 '直線の引き終わりの横位置
y2 = Cells(j, 2).Top + Cells(j, 2).Height / 2 '直線の引き終わりの縦位置
ActiveSheet.Shapes.AddLinex1 , y1, x2, y2 '線を引く
End If
Next
Next
End Sub
A 回答 (6件)
- 最新から表示
- 回答順に表示
No.6
- 回答日時:
>線を赤くしたいのですが、ForeColor.ObjectThemecolor = msoThemeColorAccent2
テーマカラーで設定されたいのでしょうか?こちらでは分り兼ねますが
赤い線を作る場合、AddLineの書き方を少し変えて
ActiveSheet.Shapes.AddLine x1, y1, x2, y2 ' 線を引く
を下記のようにします
With ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Line ' 線を引く
.ForeColor.RGB = vbRed
.Weight = 0.8
End With
Withで括り、線種や太さも変更できます(色と線の太さの例)
Qchan1962様
お世話になり、誠に有難うございました。
全くの素人が本とかで見まねでは上手くいかないところをご迷惑おかけしました。いろいろと有難うございました。
ただ、いろいろ勉強不足なので、2つの要件のコードを1枚のシートに表示すると、片方だけしか機能しないこともわかりました。これをまたどうするかを勉強していきます。有難うございました。
No.5
- 回答日時:
こんにちは
>データが変わったことを、私の能力ではどうすることも出来ません、、、そこをさらなるアドバイスを頂ければ幸いです
Range("B9:S11") = "=Randbetween(1,18)" '乱数の生成
で関数がセルに入力されていますので、上記1行を削除、
セルに残った数式が不要の場合、削除してみてください
早速の対応有難うございました。
貴殿のご回答の通り、乱数の生成を削除したら、データーが変化してしまうこともなくなりました。もう一つ、おまけに教えてください。
線を赤くしたいのですが、ForeColor.ObjectThemecolor = msoThemeColorAccent2
としたのですが、これもまた機能しません。入力する場所なのか、そのものが良くないのか、教えていただければ幸いです。
No.4
- 回答日時:
#3です
寝付きが悪くなりそうなので、追記しておきます
#3のコードは、真似をするべきコードではありません
改めて見ても書いた本人が気に入りませんが仕方ありませんね
こんな書き方もあるのか程度で(悪い例として)流してください
No.3
- 回答日時:
#1です
コードは参考にしたコードで添付図の上の部分C4:T7の範囲と言う事なのですね。
勘違いをしました。
#2様が既に回答されていますが、一応 セル範囲を少し改造し易くしてみました
Sub test()
Dim criterion As Range, target As Range
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single
Dim n As Long
Range("C4:T7").HorizontalAlignment = xlCenter '中央寄せ
'Range("C4:T7") = "=Randbetween(1,18)" '乱数の生成
ActiveSheet.Shapes.SelectAll '既存の図形を選択
Selection.Delete '既存の図形を削除
For n = 0 To Range("C4:T7").Rows.Count - 2
For Each criterion In Range("C4:T4") '
For Each target In Range("C5:T5")
If criterion.Offset(n).Value = target.Offset(n).Value Then '9行の数値と11行の数値が同じなら
x1 = criterion.Offset(n).Left + criterion.Offset(n).Width / 2 '直線の引き始めの横位置
y1 = criterion.Offset(n).Top + criterion.Offset(n).Height / 2 '直線の引き始めの縦位置
x2 = target.Offset(n).Left + target.Offset(n).Width / 2 '直線の引き終わりの横位置
y2 = target.Offset(n).Top + target.Offset(n).Height / 2 '直線の引き終わりの縦位置
ActiveSheet.Shapes.AddLine x1, y1, x2, y2 ' 線を引く
End If
Next
Next
Next n
End Sub
基準行1行の処理が終わると基準行と対象行が共に1行ずつ移動していくような処理です(1行目から3行目以降などとび行には線が引かれません)
移動回数は対象範囲の行の数で取得しています
もう少しまとめる事が出来ますが、内容が分かり難くなるかもしれないので
範囲を分けてみました
Qchan1962様
有難うございます。勘違いではなく、最初の質問には2つの要件が本当はあったのですが、私が急いでいたので、文章作成能力の欠如と質問の図にも間違いがあり、ご迷惑をおかけしました。最初にご回答いただいたのであれは良かったのです。私が9行と11行と書いたため、さらに混乱を招いたと反省しております。実際は11行と13行の間違いでした。貴殿のご回答のように作成したのですが、1点問題がありまして、線は結ばれるのですが、元々の11行と13行のデータまで変わってしまい、、、これが無知の私にはどうしたら良いかわかりません。貴殿のご回答により線で結ばれたことに大変喜びを感じた次第ですが、データが変わったことを、私の能力ではどうすることも出来ません、、、そこをさらなるアドバイスを頂ければ幸いです。
No.2
- 回答日時:
こんばんは。
4~7行に線を引くマクロを、質問者さんのマクロを元に作ってみました。
下記で、どうでしょうか?
Sub 同じ数字に線を引く()
Dim i As Long, j As Long, k As Long
ActiveSheet.Shapes.SelectAll '既存の図形を選択
Selection.Delete '既存の図形を削除
For k = 3 To 5
For i = 3 To 20 '9行の値の個数分だけ繰り返す
For j = 3 To 20 '一つの9行の値で11行全部を照合
If Cells(k, i).Value = Cells(k + 1, j).Value Then '9行の数値と11行の数値が同じなら
Call 線を引く(Cells(k, i), Cells(k + 1, j))
End If
Next j
Next i
Next k
End Sub
Sub 線を引く(myRng1 As Range, myRng2 As Range)
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single
x1 = myRng1.Left + myRng1.Width / 2 '直線の引き始めの横位置
y1 = myRng1.Top + myRng1.Height / 2 '直線の引き始めの縦位置
x2 = myRng2.Left + myRng2.Width / 2 '直線の引き終わりの横位置
y2 = myRng2.Top + myRng2.Height / 2 '直線の引き終わりの縦位置
ActiveSheet.Shapes.AddLine x1, y1, x2, y2 '線を引く
End Sub
No.1
- 回答日時:
こんばんは
Cellsの使い方がちょっと変です
'9行の値の個数分だけ繰り返す
'一つの9行の値で11行全部を照合
>Range("B9:S11")
を参考に添削すると(10行目は取り敢えず無視しています)
Sub test()
Dim i As Long, j As Long
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single
Range("B9:S11").HorizontalAlignment = xlCenter '中央寄せ
Range("B9:S11") = "=Randbetween(1,18)" '乱数の生成
ActiveSheet.Shapes.SelectAll '既存の図形を選択
Selection.Delete '既存の図形を削除
For i = 2 To 19 '9行の値の個数分だけ繰り返す
For j = 2 To 19 '一つの9行の値で11行全部を照合
If Cells(9, i) = Cells(11, j) Then '9行の数値と11行の数値が同じなら
x1 = Cells(9, i).Left + Cells(9, i).Width / 2 '直線の引き始めの横位置
y1 = Cells(9, i).Top + Cells(9, i).Height / 2 '直線の引き始めの縦位置
x2 = Cells(11, j).Left + Cells(11, j).Width / 2 '直線の引き終わりの横位置
y2 = Cells(11, j).Top + Cells(11, j).Height / 2 '直線の引き終わりの縦位置
ActiveSheet.Shapes.AddLine x1, y1, x2, y2 ' 線を引く
End If
Next
Next
End Sub
コード内の定数:
2はB列 19はS列
9は9行目 11は11行目
早速のご回答有難うございます。私は、本、人のまねをしてのまだ素人です。
ただ、10行を無視したというよりも、私の作成利用している表では1行空けているからです。それが問題であれば、その行をなくしたいと思います。
早速いまから、試してみたいと思います。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) VBAで組み合わせ算出やCOUNTIFSの処理を高速化したいです。 4 2022/04/07 02:38
- Visual Basic(VBA) 数字が「0」の列を削除するため、下記のコードを実行しましたが、コンパイルエラーSubまたはFunct 3 2022/12/04 00:00
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Excel(エクセル) マクロで最終行から上に検索を逆にしたい 1 2022/05/17 18:27
- Visual Basic(VBA) EXCEL VBAにて動的にCheckBOXを複数作成し、同BOXにイベントを追加したい 1 2023/03/16 07:05
- Visual Basic(VBA) vbaの計算 if elseと範囲について 6 2022/11/26 01:49
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
首吊りどこ締めるの
-
白血球が多いとどんな心配があ...
-
検便についてです。 便は取れた...
-
EXCELで条件付き書式で空白セル...
-
彼女のことが好きすぎて彼女の...
-
至急!尿検査前日にオナニーし...
-
甲状腺が腫れているが血液検査...
-
勃起する時って痛いんですか? ...
-
小数点以下を繰り上げたものを...
-
MIN関数で空白セルを無視したい...
-
値が入っているときだけ計算結...
-
2つの数値のうち、数値が小さい...
-
エクセル指定した範囲からラン...
-
尿検査前日に自慰行為した時の...
-
中出しをするとお腹が痛い・・・。
-
一番多く表示のある値(文字列...
-
精子が黄色?
-
【Excelで「正弦波」のグラフを...
-
ある範囲のセルから任意の値を...
-
Excel条件付書式(残業45時間以...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
首吊りどこ締めるの
-
至急!尿検査前日にオナニーし...
-
白血球が多いとどんな心配があ...
-
尿検査前日に自慰行為した時の...
-
検便についてです。 便は取れた...
-
彼女のことが好きすぎて彼女の...
-
腕を見たら黄色くなってる部分...
-
勃起する時って痛いんですか? ...
-
尿検査の前日は自慰控えたほう...
-
精子が黄色?
-
中出しをするとお腹が痛い・・・。
-
EXCELで条件付き書式で空白セル...
-
口の中に黒い血の塊
-
これって喉仏ですか? 私は女性...
-
2つの数値のうち、数値が小さい...
-
納豆食べた後の尿の納豆臭は何故?
-
EXCELで式からグラフを描くには?
-
小数点以下を繰り上げたものを...
-
excelでsin二乗のやり方を教え...
-
エクセル指定した範囲からラン...
おすすめ情報