Excel VBA質問箱 IV

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

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


37983 / 76738 ←次へ | 前へ→

【43901】Re:変数の値を循環させて使用するには
質問  yata  - 06/10/28(土) 22:08 -

引用なし
パスワード
   有難うございます。
こんな長いものを載せてご迷惑かと思いますが怒らないで下さい。
3本のオートシェープの直線で作成された三角形がどのような形で作られているかを調べてその反対側に新しい三角形を作る際の判断に使用しています。
選択されている線がa線、b線、c線の場合分けが必要ですが変数を入れ替えるだけで 43行目から下のIf分岐は1回ですむのではないかと思いました。
Function Handan()
With Selection.ShapeRange
  myLineName = .Name
  '左端を(p,q),右端を(r,s)。右下がりの場合は(p,s),(r,q)となる。
  p = .Left
  q = .Top + .Height
  r = .Left + .Width
  s = .Top
End With
  aLine = LineNumber & "a"
  bLine = LineNumber & "b"
  cLine = LineNumber & "c"
'______________________________________________________
If LineNumber = 0 Then    '基準線の場合
    Select Case Range("B3")
      Case Is = "上か左"
        Handan = "Sitei-Upper"
      Case Is = "下か右"
        Handan = "Sitei-Down"
    End Select
End If
'______________________________________________________
If LineNumber >= 1 Then   '三角形が1つ以上作成されている時
  With ActiveSheet.Shapes(cLine)
    cLeft = .Left
    cTop = .Top
    cHeight = .Height
    cRight = .Left + .Width
    cUnder = .Top + .Height
  End With
  With ActiveSheet.Shapes(aLine)
    aLeft = .Left
    aTop = .Top
    aHeight = .Height
    aRight = .Left + .Width
    aUnder = .Top + .Height
  End With
  With ActiveSheet.Shapes(bLine)
    bLeft = .Left
    bTop = .Top
    bHeight = .Height
    bRight = .Left + .Width
    bUnder = .Top + .Height
  End With
'a線が選択された場合
  If Right(myLineName, 1) = "a" Then
    If (p = cLeft) Or (p = cRight) Then '上に作る
      Select Case q
        Case cTop, cUnder
          Select Case s
            Case bTop, bUnder
              Select Case r
                Case bLeft, bRight
                  Handan = "MigiAgariUe"
                Case Is = cRight
                  Handan = "MigiSagariSita"
                Case Else
                  Handan = "MigiAgariUe"
              End Select
            Case Is = cTop
              Select Case r
                Case bRight
                  Handan = "MigiSagariUe"
                Case Else
                  Handan = "MigiAgariUe"
              End Select
          End Select
        Case bTop, bUnder
          Select Case s
            Case cTop, cUnder
              Select Case r
                Case bLeft, bRight
                  Handan = "MigiSagariUe"
                Case Else
                  Handan = "MigiAgariSita"
              End Select
            Case Is = bTop
              Handan = "MigiSagariUe"
          End Select
      End Select
    ElseIf (p = bLeft) Or (p = bRight) Then  '下に作る
      Select Case q
        Case bTop, bUnder
          Select Case s
            Case cTop, cUnder
              Select Case r
                Case cLeft, cRight
                  Handan = "MigiAgariSita"
                Case Else
                  Handan = "MigiSagaiUe"
              End Select
            Case Is = bTop
              Handan = "MigiAgariSita"
          End Select
        Case cTop, cUnder
          Select Case s
            Case bTop, bUnder
              Select Case r
                Case cLeft, cRight
                  Handan = "MigiSagariSita"
                Case Else
                  Handan = "MigiAgariUe"
              End Select
            Case Is = cTop
              Handan = "MigiSagariSita"
          End Select
      End Select
    End If
'-----------------------------------------------------------
 'ここから下を省略したいです
 'b線が選択された場合    
  ElseIf Right(myLineName, 1) = "b" Then
    If (p = aLeft) Or (p = aRight) Then '上に作る
      Select Case q
        Case aTop, aUnder
          Select Case s
            Case cTop, cUnder
              Select Case r
                Case cLeft, cRight
                  Handan = "MigiAgariUe"
                Case Is = aRight
                  Handan = "MigiSagariSita"
                Case Else
                  Handan = "MigiAgariUe"
              End Select
            Case Is = aTop
              Select Case r
                Case cRight
                  Handan = "MigiSagariUe"
                Case Else
                  Handan = "MigiAgariUe"
              End Select
          End Select
        Case cTop, cUnder
          Select Case s
            Case aTop, aUnder
              Select Case r
                Case cLeft, cRight
                  Handan = "MigiSagariUe"
                Case Else
                  Handan = "MigiAgariSita"
              End Select
            Case Is = cTop
              Handan = "MigiSagariUe"
          End Select
      End Select
    ElseIf (p = cLeft) Or (p = cRight) Then '下に作る
      Select Case q
        Case cTop, cUnder
          Select Case s
            Case aTop, aUnder
              Select Case r
                
                Case aLeft, aRight
                  Handan = "MigiAgariSita"
                
                Case Else
                  Handan = "MigiSagariUe"
              End Select
            Case Is = cTop
              Handan = "MigiSagariSita"
          End Select
        Case aTop, aUnder
          Select Case s
            Case cTop, cUnder
              Select Case r
                Case aLeft, aRight
                  Handan = "MigiSagariSita"
                
                Case Else
                  Handan = "MigiAgariUe"
              End Select
            Case Is = aTop
              Handan = "MigiSagariSita"

          End Select
      End Select
    End If
 'c線が選択された場合
  ElseIf Right(myLineName, 1) = "c" Then
'
以下略
'10000文字を超えるためエラーで送信できません
End Function
0 hits

【43896】変数の値を循環させて使用するには yata 06/10/28(土) 20:30 質問
【43897】Re:変数の値を循環させて使用するには かみちゃん 06/10/28(土) 20:54 発言
【43898】Re:変数の値を循環させて使用するには yata 06/10/28(土) 21:03 発言
【43899】Re:変数の値を循環させて使用するには かみちゃん 06/10/28(土) 21:16 発言
【43901】Re:変数の値を循環させて使用するには yata 06/10/28(土) 22:08 質問
【43902】Re:変数の値を循環させて使用するには Hirofumi 06/10/28(土) 22:14 回答
【43903】Re:変数の値を循環させて使用するには yata 06/10/28(土) 23:27 質問
【43904】Re:変数の値を循環させて使用するには Hirofumi 06/10/29(日) 1:09 回答
【43907】Re:変数の値を循環させて使用するには Hirofumi 06/10/29(日) 6:39 回答
【43908】Re:変数の値を循環させて使用するには yata 06/10/29(日) 8:26 お礼
【43913】Re:結果報告 yata 06/10/29(日) 16:55 お礼

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