Excel VBA質問箱 IV

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

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


6666 / 13646 ツリー ←次へ | 前へ→

【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 お礼[未読]

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

引用なし
パスワード
   こんばんは
皆様にはたびたびお世話になり大変ありがたく思っています。
コードの行数を短くするため、プログラムの中で変数を交換したいのですが、
教えて頂けませんか?
下記の様に変数の値を循環させて使用したいです。
Case "い" の左辺c1〜c3 とCsae "う" の左辺b1〜c3にうまく設定できません。
最初に変数名を別のもの(aa1="A1",aa2="A2",.....cc3="C3" )に
して代入するしかありませんか?
実際はRange("b1")のところが If 分岐で3回それぞれ60行で合計180行位の
冗長なコードになって困っております。
Sub 変数入れ替え()
  a1 = "A1"
  a2 = "A2"
  a3 = "A3"
  b1 = "B1"
  b2 = "B2"
  b3 = "B3"
  c1 = "C1"
  c2 = "C2"
  c3 = "C3"

Select Case Range("a1")
  Case "い"
    a1 = b1
    a2 = b2
    a3 = b3
    b1 = c1
    b2 = c2
    b3 = c3
    c1 = a1    'ここから
    c2 = a2
    c3 = a3
  Case "う"
    a1 = c1
    a2 = c2
    a3 = c3
    b1 = a1    'ここから
    b2 = a2
    b3 = a3
    c1 = b1
    c2 = b2
    c3 = b3
End Select
Range("b1") = a1 & a2 & a3 & b1 & b2 & b3 & c1 & c2 & c3

End Sub

【43897】Re:変数の値を循環させて使用するには
発言  かみちゃん  - 06/10/28(土) 20:54 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> コードの行数を短くするため、プログラムの中で変数を交換したい

なぜそのようなことがしたいのかわかりません。
また、どのようにうまくいかないのかもわかりません。
もう少し具体的に説明していただけませんか?

【43898】Re:変数の値を循環させて使用するには
発言  yata  - 06/10/28(土) 21:03 -

引用なし
パスワード
   かみちゃん さん ありがとうございます。

>もう少し具体的に説明していただけませんか?
実際のコードを見てもらいたいのですがなにぶん行数が多いので躊躇しております。この投稿欄では何行くらいなら載せても良いですか?

【43899】Re:変数の値を循環させて使用するには
発言  かみちゃん E-MAIL  - 06/10/28(土) 21:16 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>もう少し具体的に説明していただけませんか?
>実際のコードを見てもらいたいのですがなにぶん行数が多いので躊躇しております。この投稿欄では何行くらいなら載せても良いですか?

行数の制限は、知りませんが、載せられないくらいの行数なのですか?
載せてみれば?と思うのですが・・・

【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

【43902】Re:変数の値を循環させて使用するには
回答  Hirofumi  - 06/10/28(土) 22:14 -

引用なし
パスワード
   コードをまだ見て居ないのですが?
多分こんな事かと思いますが?

普通は変数の入替えをするのでは無く、
配列にデータを入れて、読み出しを工夫すると思うのですが?
例えば、読み出し順に規則性が無い場合は媒介変数を使って読み出します
また、規則性が有る様なら、「\」、「MOD」演算子を組み合わせて読み出し順を工夫します

Option Explicit

Sub 変数入れ替え2()

'  読み出しに規則性が無い場合
'  媒介変数を使用

  Dim i As Long
  Dim vntData As Variant
  Dim vntPos As Variant
  Dim vntResult As Variant
  
  vntData = Array("A1", "A2", "A3", "B1", "B2", "B3", "C1", "C2", "C3")
  
  Select Case Range("a1").Value
    Case "い"
      vntPos = Array(3, 4, 5, 6, 7, 8, 0, 1, 2)
    Case "う"
      vntPos = Array(6, 7, 8, 0, 1, 2, 3, 4, 5)
  End Select
  
  For i = 0 To UBound(vntPos)
    vntResult = vntResult & vntData(vntPos(i))
  Next i
  
  Range("b1").Value = vntResult

End Sub

Sub 変数入れ替え3()

'  読み出しに規則性が有る場合
'  「\」、「MOD」演算子を使用

  Dim i As Long
  Dim vntData As Variant
  Dim lngMax As Long
  Dim lngPos As Long
  Dim vntResult As Variant
  
  vntData = Array("A1", "A2", "A3", "B1", "B2", "B3", "C1", "C2", "C3")
  lngMax = UBound(vntData)
  
  Select Case Range("a1").Value
    Case "い"
      For i = 0 To lngMax
        lngPos = (i + 3) Mod (lngMax + 1)
        vntResult = vntResult & vntData(lngPos)
      Next i
    Case "う"
      For i = 0 To lngMax
        lngPos = (i + 6) Mod (lngMax + 1)
        vntResult = vntResult & vntData(lngPos)
      Next i
  End Select
  
  Range("b1").Value = vntResult

End Sub

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

引用なし
パスワード
   Hirofumi さん 有難うございます。
>多分こんな事かと思いますが?
質問の仕方が悪かったです。コードを載せました。
中ほどから下のIF文を省略できないかと考えました。
>普通は変数の入替えをするのでは無く、
>配列にデータを入れて、読み出しを工夫すると思うのですが?
最初は
Dim Hensu(8)
Hensu(0)="A1"
Hensu(1)="A2"
のようなことを考えましたが、コードが読みづらくなってしまうので
a線が選択されている場合だけを使ったコードを生かしたいです。

>また、規則性が有る様なら、「\」、「MOD」演算子を組み合わせて読み出し順を工夫します
>        lngPos = (i + 6) Mod (lngMax + 1)
>        vntResult = vntResult & vntData(lngPos)
始めて見ました。これで配列の番目の値が取得できるのですね?
勉強になりました。

【43904】Re:変数の値を循環させて使用するには
回答  Hirofumi  - 06/10/29(日) 1:09 -

引用なし
パスワード
   ウーム??、善く解らないけどこんな事なのかな?

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").Value
      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
      Handan = LineSelected(q, s, r, cRight, cLeft, _
            cTop, cUnder, bRight, bLeft, bTop, bUnder)
'-----------------------------------------------------------
    'b線が選択された場合
    ElseIf Right(myLineName, 1) = "b" Then
      Handan = LineSelected(q, s, r, aRight, aLeft, _
            aTop, aUnder, cRight, cLeft, cTop, cUnder)
    'c線が選択された場合
    ElseIf Right(myLineName, 1) = "c" Then
      Handan = LineSelected(q, s, r, bRight, bLeft, _
            bTop, bUnder, aRight, aLeft, aTop, aUnder)
    End If
  
End Function

Private Function LineSelected(lngQ As Long, _
                lngS As Long, _
                lngR As Long, _
                Right1 As Long, _
                Left1 As Long, _
                Top1 As Long, _
                Under1 As Long, _
                Right2 As Long, _
                Left2 As Long, _
                Top2 As Long, _
                Under2 As Long) As String

  If (lngQ = Left1) Or (lngQ = Right1) Then '上に作る
    Select Case lngQ
      Case Top1, Under1
        Select Case lngS
          Case Top2, Under2
            Select Case lngR
              Case Left2, Right2
                LineSelected = "MigiAgariUe"
              Case Is = Right1
                LineSelected = "MigiSagariSita"
              Case Else
                LineSelected = "MigiAgariUe"
            End Select
          Case Is = Top1
            Select Case lngR
              Case Right2
                LineSelected = "MigiSagariUe"
              Case Else
                LineSelected = "MigiAgariUe"
            End Select
        End Select
      Case Top2, Under2
        Select Case lngS
          Case Top1, Under1
            Select Case lngR
              Case Left2, Right2
                LineSelected = "MigiSagariUe"
              Case Else
                LineSelected = "MigiAgariSita"
            End Select
          Case Is = Top2
            LineSelected = "MigiSagariUe"
        End Select
    End Select
  ElseIf (lngQ = Left2) Or (lngQ = Right2) Then '下に作る
    Select Case lngQ
      Case Top2, Under2
        Select Case lngS
          Case Top1, Under1
            Select Case lngR
              Case Left1, Right1
                LineSelected = "MigiAgariSita"
              Case Else
                LineSelected = "MigiSagariUe"
            End Select
          Case Is = Top2
            LineSelected = "MigiAgariSita"
        End Select
      Case Top1, Under1
        Select Case lngS
          Case Top2, Under2
            Select Case lngR
              Case Left1, Right1
                LineSelected = "MigiSagariSita"
              Case Else
                LineSelected = "MigiAgariUe"
            End Select
          Case Is = Top1
            LineSelected = "MigiSagariSita"
        End Select
    End Select
  End If
  
End Function

【43907】Re:変数の値を循環させて使用するには
回答  Hirofumi  - 06/10/29(日) 6:39 -

引用なし
パスワード
   あ!、ゴメン、間違えてる!
こうなるみたいですね?

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").Value
      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
      Handan = LineSelected(p, q, s, r, cRight, cLeft, _
            cTop, cUnder, bRight, bLeft, bTop, bUnder)
'-----------------------------------------------------------
    'b線が選択された場合
    ElseIf Right(myLineName, 1) = "b" Then
      Handan = LineSelected(p, q, s, r, aRight, aLeft, _
            aTop, aUnder, cRight, cLeft, cTop, cUnder)
'-----------------------------------------------------------
    'c線が選択された場合
    ElseIf Right(myLineName, 1) = "c" Then
      Handan = LineSelected(p, q, s, r, bRight, bLeft, _
            bTop, bUnder, aRight, aLeft, aTop, aUnder)
    End If

End Function

Private Function LineSelected(lngP As Long, _
                lngQ As Long, _
                lngS As Long, _
                lngR As Long, _
                Right1 As Long, _
                Left1 As Long, _
                Top1 As Long, _
                Under1 As Long, _
                Right2 As Long, _
                Left2 As Long, _
                Top2 As Long, _
                Under2 As Long) As String

  If (lngP = Left1) Or (lngP = Right1) Then '上に作る
    Select Case lngQ
      Case Top1, Under1
        Select Case lngS
          Case Top2, Under2
            Select Case lngR
              Case Left2, Right2
                LineSelected = "MigiAgariUe"
              Case Is = Right1
                LineSelected = "MigiSagariSita"
              Case Else
                LineSelected = "MigiAgariUe"
            End Select
          Case Is = Top1
            Select Case lngR
              Case Right2
                LineSelected = "MigiSagariUe"
              Case Else
                LineSelected = "MigiAgariUe"
            End Select
        End Select
      Case Top2, Under2
        Select Case lngS
          Case Top1, Under1
            Select Case lngR
              Case Left2, Right2
                LineSelected = "MigiSagariUe"
              Case Else
                LineSelected = "MigiAgariSita"
            End Select
          Case Is = Top2
            LineSelected = "MigiSagariUe"
        End Select
    End Select
  ElseIf (lngP = Left2) Or (lngP = Right2) Then '下に作る
    Select Case lngQ
      Case Top2, Under2
        Select Case lngS
          Case Top1, Under1
            Select Case lngR
              Case Left1, Right1
                LineSelected = "MigiAgariSita"
              Case Else
                LineSelected = "MigiSagariUe"
            End Select
          Case Is = Top2
            LineSelected = "MigiAgariSita"
        End Select
      Case Top1, Under1
        Select Case lngS
          Case Top2, Under2
            Select Case lngR
              Case Left1, Right1
                LineSelected = "MigiSagariSita"
              Case Else
                LineSelected = "MigiAgariUe"
            End Select
          Case Is = Top1
            LineSelected = "MigiSagariSita"
        End Select
    End Select
  End If
  
End Function

【43908】Re:変数の値を循環させて使用するには
お礼  yata  - 06/10/29(日) 8:26 -

引用なし
パスワード
   おはようございます。
Hirofumi さん 有難うございました。
関数をもう1つ作るんですね。
今日は家内孝行のためこれから紅葉狩りに出かけなければなりません。
帰ってからテストしたいと思います。
結果は後でご報告いたします。
先ずはお礼まで。

【43913】Re:結果報告
お礼  yata  - 06/10/29(日) 16:55 -

引用なし
パスワード
   Hirofumi さん
うまく行きました。
Private Function LineSelected(lngP As Long, _
                lngQ As Long, _
                lngS As Long, _
                lngR As Long, _
                Right1 As Long, _
                Left1 As Long, _
                Top1 As Long, _
                Under1 As Long, _
                Right2 As Long, _
                Left2 As Long, _
                Top2 As Long, _
                Under2 As Long) As String
ここを
Private Function LineSelected(ByVal lngP As Long, _
                ByVal lngQ As Long, _
                ByVal lngS As Long, _
                ByVal lngR As Long, _
                ByVal Right1 As Long, _
                ByVal Left1 As Long, _
                ByVal Top1 As Long, _
                ByVal Under1 As Long, _
                ByVal Right2 As Long, _
                ByVal Left2 As Long, _
                ByVal Top2 As Long, _
                ByVal Under2 As Long) As String
に変更してばっちりです。コードが100行も短縮されてすっきりしました。
展開図作成マクロを作ったのですが、選択されている直線の傾きを調べるのに四苦八苦しました。
結局、3つの辺がどの様にくっついているか全て調べ上げ、こんな分岐の多いコードになってしまいました。
またお世話になるかもしれませんが今後ともよろしくお願いします。
有難うございました。

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