Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8123 / 13645 ツリー ←次へ | 前へ→

【34975】罫線の有無による計算式 下働き 06/2/17(金) 13:49 質問[未読]
【34996】Re:罫線の有無による計算式 Ned 06/2/17(金) 20:06 発言[未読]
【35052】Re:罫線の有無による計算式 下働き 06/2/20(月) 13:14 お礼[未読]

【34975】罫線の有無による計算式
質問  下働き  - 06/2/17(金) 13:49 -

引用なし
パスワード
   題名の件について質問させて頂きます。
例えば下記のようなシートがある場合

  A   B    C    D   E
1   |_____       上  10
2             左  20
3    _____       下  30
4             右  40

B1とD1においてそのセルの罫線位置によってE列の値を合計する
場合の式作成をお教え下さい。
例)B1は左と下に罫線があるのでE2とE3の合計50
  B4は上に罫線があるのでE1=10となる。

この計算式及び罫線は別のプロセスで追加、変更されるため
自作関数として作成したいと考えています。
そこで、以下の式を作ってみたのですが、動きません。
ご助力、宜しくお願いします。

__________________________________

Function test_SEN(自身のCELL As Borders, E1 As Double, _
          E3 As Double, E4 As Double)

'罫線情報取得テスト
  Dim KEISEN_TOP As Borders
  Dim KEISEN_LEFT As Borders
  Dim KEISEN_BOTTOM As Borders
  Dim KEISEN_RIGHT As Borders
  Dim shoukei As Double
  
  shoukei = 0

  KEISEN_TOP = Range(自身のCELL).Borders(xlEdgeTop).LineStyle
  KEISEN_LEFT = Range(自身のCELL).Borders(xlEdgeLeft).LineStyle
  KEISEN_RIGHT = Range(自身のCELL).Borders(xlEdgeRight).LineStyle
  KEISEN_BOTTOM = Range(自身のCELL).Borders(xlEdgeBottom).LineStyle
  
  If KEISEN_TOP <> xlNone Then shoukei = shoukei + E1
  If KEISEN_LEFT <> xlNone Then shoukei = shoukei + E2
  If KEISEN_RIGHT <> xlNone Then shoukei = shoukei + E4
  If KEISEN_BOTTOM <> xlNone Then shoukei = shoukei + E3
  
  test_SEN = shoukei
    
End Function

【34996】Re:罫線の有無による計算式
発言  Ned  - 06/2/17(金) 20:06 -

引用なし
パスワード
   こんにちは。とりあえず、

Sub sample()
  MsgBox test_SEN(ActiveCell, Range("e1").Value _
    , Range("e2").Value, Range("e3").Value, Range("e4").Value)
End Sub

Function test_SEN(自身のCELL As Range, E1 As Double, _
        E2 As Double, E3 As Double, E4 As Double)
'罫線情報取得テスト
  Dim KEISEN_TOP As Long
  Dim KEISEN_LEFT As Long
  Dim KEISEN_BOTTOM As Long
  Dim KEISEN_RIGHT As Long
  Dim shoukei As Double
  shoukei = 0
  KEISEN_TOP = 自身のCELL.Borders(xlEdgeTop).LineStyle
  KEISEN_LEFT = 自身のCELL.Borders(xlEdgeLeft).LineStyle
  KEISEN_RIGHT = 自身のCELL.Borders(xlEdgeRight).LineStyle
  KEISEN_BOTTOM = 自身のCELL.Borders(xlEdgeBottom).LineStyle
  If KEISEN_TOP <> xlNone Then shoukei = shoukei + E1
  If KEISEN_LEFT <> xlNone Then shoukei = shoukei + E2
  If KEISEN_RIGHT <> xlNone Then shoukei = shoukei + E4
  If KEISEN_BOTTOM <> xlNone Then shoukei = shoukei + E3
  test_SEN = shoukei
End Function

などとすれば動くでしょうけど、もう少しすっきりするような気はします。

With 自身のCELL
  If .Borders(xlEdgeTop).LineStyle <> xlNone Then shoukei = shoukei + E1
  If .Borders(xlEdgeLeft).LineStyle <> xlNone Then shoukei = shoukei + E2
  If .Borders(xlEdgeRight).LineStyle <> xlNone Then shoukei = shoukei + E4
  If .Borders(xlEdgeBottom).LineStyle <> xlNone Then shoukei = shoukei + E3
End With

あと、E1:E4までの引数設定についても、配列を使ったほうがいいのでしょうけど?
(今ひとつ詳しくないのでパスします)

【35052】Re:罫線の有無による計算式
お礼  下働き  - 06/2/20(月) 13:14 -

引用なし
パスワード
   Ned 様

こんにちは、下働きです。

御助言頂いた内容で試してみましたところ計算することが出来ました。
また、アドヴァイスのように、余計な代入等を省いた方が、軽くなる
のでしょうね。この度は、ありがとうございました。

Function test_KEISEN(自身のCELL As Range, E1 As Double, _
        E2 As Double, E3 As Double, E4 As Double)
'罫線情報取得テスト
  Dim shoukei As Double
  
  shoukei = 0
  If 自身のCELL.Borders(xlEdgeTop).LineStyle <> xlNone Then _
       shoukei = shoukei + E1
  If 自身のCELL.Borders(xlEdgeLeft).LineStyle <> xlNone Then _
       shoukei = shoukei + E2
  If 自身のCELL.Borders(xlEdgeRight).LineStyle <> xlNone Then _
       shoukei = shoukei + E4
  If 自身のCELL.Borders(xlEdgeBottom).LineStyle <> xlNone Then _
       shoukei = shoukei + E3
  test_KEISEN = shoukei
End Function

ただ上記内容だけですと、罫線の書き換えには計算結果が対応しないなど
改良の余地ありです。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)を弄るか
罫線書き換えプロセスを工夫するかで対応するつもりです。

8123 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free