ここから本文です

-------------------------------------- Sub 柱状図作成() Dim i As Long Dim ...

アバター

ID非公開さん

2018/3/1820:20:20

--------------------------------------
Sub 柱状図作成()
Dim i As Long
Dim W As Single

Dim 開始X As Single
Dim 開始Y As Single
Dim 終了X As Single
Dim 終了Y As Single

ActiveSheet.Shapes.SelectAll
Selection.Delete
W = Columns(3).Width / 10 '55
開始X = Cells(3, 3).Left + Cells(3, 3).Height / 2 'W
For i = 3 To 17
If Cells(i, 2) <> "" Then
開始Y = Cells(i, 2).Top + Cells(i, 2).Height / 2
終了Y = Rows(i + 1).Top + Rows(i + 1).Height / 2 'Cells(i + 1, 2).Top + Cells(i + 1, 2).Height / 2
If i <> 3 Then
開始X = 終了X
End If
終了X = Columns(3).Left + Cells(i + 1, 2) * W '開始X + (Cells(i + 1, 2) - Cells(i, 2)) * 4.6
With ActiveSheet.Shapes.AddLine(開始X, 開始Y, 終了X, 終了Y).Line
.ForeColor.RGB = vbRed
.Weight = 1
.BeginArrowheadStyle = msoArrowheadOval
.EndArrowheadStyle = msoArrowheadOval
End With
End If
Next
End Sub
---------------------------
ほぼ完成だと思っていたんですが「B3」セルが「0」なのに「C3」に
プロットされているのは「0」になっていないんです。
「B10」を、試しに「0」にしたらきちんと「0」へ行くのですが。

End If,Dim i As Long,ForeColor.RGB,開始Y As Single,開始X As Single,End With,Rows.Count

閲覧数:
70
回答数:
3
お礼:
25枚

違反報告

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

kik********さん

2018/3/1909:27:09

答えはすでに出ているようですが

> 開始X = Cells(3, 3).Left + Cells(3, 3).Height / 2 'W

X 用に Height が出てくること自体おかしい
これは、For 1 巡で、2点求めようとしているから、複雑になっているように思えます

1 巡では、各点を配列で覚える様にして、
出来上がった配列の、隣り合った点を使って線を引けば・・・スッキリ?

雰囲気以下の様な感じで


Option Explicit

Public Sub Samp1()
   Dim vA As Variant, vS As Variant, v As Variant
   Dim x As Single, y As Single, o As Single, w As Single
   Dim i As Long, k As Long, n As Long

   vA = Array()
   k = LBound(vA)
   n = UBound(vA)
   With ActiveSheet
      With .Range("B3", .Cells(Rows.Count, "B").End(xlUp))
         With .Cells(1).Offset(, 1)
            o = .Left
            w = .Width / 10
         End With
         For i = 1 To .Rows.Count
            With .Cells(i)
               If (.Value <> "") Then
                  x = .Value * w + o
                  y = .Top + .Height / 2
                  n = n + 1
                  ReDim Preserve vA(n)
                  vA(n) = Array(x, y)
               End If
            End With
         Next
      End With

      If (n > k) Then
         Application.ScreenUpdating = False
         With .Shapes
            If (.Count > 0) Then
               .SelectAll
               Selection.Delete
            End If

            For Each v In vA
               If (Not IsEmpty(vS)) Then
                  With .AddLine(vS(k), vS(k + 1), v(k), v(k + 1))
                     With .Line
                        .ForeColor.RGB = vbRed
                        .Weight = 1
                        .BeginArrowheadStyle = msoArrowheadOval
                        .EndArrowheadStyle = msoArrowheadOval
                     End With
                  End With
               End If
               vS = v
            Next
         End With
         Application.ScreenUpdating = True
      End If
   End With
End Sub

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

kak********さん

2018/3/1823:30:19

W = Columns(3).Width / 10 '55
開始X = Cells(3, 3).Left + Cells(3, 3).Height / 2
終了X = Columns(3).Left + Cells(i + 1, 2) * W

初期値を開始Xに設定する式はCells(3, 3)のHeight / 2を足していますが、終了XはWを掛けていて計算方法が異なるように思います。
初期値を与えるコードは正しいのでしょうか?

nan********さん

2018/3/1821:21:09

わかったななし

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

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

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

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

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

閉じる

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

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

閉じる