ここから本文です

恐れ入ります 黒丸線つなぎ 質問させていただきます。 少し様式が変わりました...

jun********さん

2019/3/1815:17:48

恐れ入ります
黒丸線つなぎ 質問させていただきます。

少し様式が変わりました。
AE列の入力は関係なくなりました。

下記のコードにて
AA列に直接数字を入力すると思うようになりますが、
次の式でAA列には関数で入力させると、黒丸が入りませんし、
線も描かれません。
=IFERROR($D$12/U23*X23,"")
どこをどのように修正したらよいでしょうか?

以下、現在のコードです
(AAに直接入力すると、うまく動きますが、関数ではだめでした)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("AA:AA")) Is Nothing Then Exit Sub
Dim sh As Shape
Dim r As Long
Dim x As Single
Dim y As Single
Dim lastX As Single
Dim lastY As Single
For Each sh In ActiveSheet.Shapes
If sh.Type = msoShapeOval Or sh.Type = msoConnectorStraight Then sh.Delete
Next
For r = 21 To Range("AA" & Rows.Count).End(xlUp).Row '2行目からAA列最終行まで
If Range("AA" & r).Value <> 0 Then 'AE列が0でなければ
x = Range("AA" & r).Value '注目行のx
y = r '注目行のy
dot x, y '現在の点
If lastY <> 0 Then connect lastX, lastY, x, y '前の終了座標のyが0で無ければ(現在の点と結ぶ点があれば)現在の点と結ぶ
lastX = x '現在のxを次の開始xに
lastY = y '現在のyを次の開始yに
End If
Next
End Sub

'座標変換(AAの値と注目行をx,y座標に変換)
Sub getPoint(x As Single, y As Single)
If x < 0 Then x = 0 'マイナスは0
Dim rng As Range
Set rng = Cells(y + 1, x \ 10 + 4) '対象セル
x = rng.Left + rng.Width / 10 * (x Mod 10) 'セルのLeft+10等分した1桁分した座標
y = rng.Top '行をy座標に
End Sub

'点
Sub dot(ByVal x As Single, ByVal y As Single)
getPoint x, y '座標変換
With ActiveSheet.Shapes.AddShape(msoShapeOval, x - 3, y - 3, 6, 6) '点描画
.Line.Visible = msoFalse '線無し
.Fill.ForeColor.RGB = RGB(0, 0, 0) '黒点
End With
End Sub

'線
Sub connect(ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single)
getPoint x1, y1 '座標変換
getPoint x2, y2 '座標変換
With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1, y1, x2, y2).Line '結ぶ
.Weight = 3 '太さ1
.ForeColor.RGB = RGB(0, 0, 0) '黒線
End With
End Sub

この質問は、hot********さんに回答をリクエストしました。

閲覧数:
26
回答数:
1

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

hot********さん

リクエストマッチ

2019/3/1816:02:09

AA列は計算結果として変化してるだけなので、AA列のWorksheet_Changeでは変化が取得できないので処理できません。
実際に手動させるセル範囲が必要です。
AA列が
=IFERROR($D$12/U23*X23,"")
と言う式の場合は、手動で変化するのはD12、U列、X列が対象なので

>If Intersect(Target, Range("AA:AA")) Is Nothing Then Exit Sub



If Intersect(Target, Range("D12,U:U,X:X")) Is Nothing Then Exit Sub

に変更してください。
またAA列が数値以外の場合に備えて

>If Range("AA" & r).Value <> 0 Then 'AE列が0でなければ
>x = Range("AA" & r).Value '注目行のx



If Val(Range("AA" & r).Value) <> 0 Then 'AE列が0でなければ
x = Val(Range("AA" & r).Value) '注目行のx

に変更してください。

質問した人からのコメント

2019/3/18 16:41:58

この度は早速のお返事ありがとうございます。
おかげさまで、全て思うようにさせることが出来ました。
大変感謝申し上げます。

まだまだやりたいことがたくさんあります。
今後ともよろしくお願いいたします。

ありがとうございました。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる