Excel VBA質問箱 IV

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

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


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

【48805】別のシートのデータを利用 シスアド 07/5/9(水) 22:05 質問[未読]
【48807】Re:別のシートのデータを利用 ichinose 07/5/10(木) 7:38 発言[未読]
【48827】Re:別のシートのデータを利用 シスアド 07/5/10(木) 19:09 発言[未読]
【48843】Re:別のシートのデータを利用 ichinose 07/5/11(金) 7:31 発言[未読]
【48857】Re:別のシートのデータを利用 シスアド 07/5/11(金) 23:16 発言[未読]
【48864】Re:別のシートのデータを利用 ichinose 07/5/12(土) 17:55 発言[未読]
【48871】Re:別のシートのデータを利用 シスアド 07/5/13(日) 20:00 お礼[未読]
【48874】Re:別のシートのデータを利用 シスアド 07/5/13(日) 21:02 質問[未読]
【48878】Re:別のシートのデータを利用 ichinose 07/5/14(月) 8:59 発言[未読]
【48941】Re:別のシートのデータを利用 シスアド 07/5/16(水) 19:27 お礼[未読]

【48805】別のシートのデータを利用
質問  シスアド  - 07/5/9(水) 22:05 -

引用なし
パスワード
   下記のように、セルBK2に0.1.2.3のいづれかが入力された場合Caseによって条件があるマクロを作成しました。
これを同じSheetのリストという名前のセルBK2ではなく、データという名前のSheetのセルO2に値が入力されており、それを使用し、リストという名前に出力したいのですがどうしたらよいでしょうか?
補足をお願いします。

sub()
a=0
Dim c As Range

For Each c ln Range("BK2")
Select Case c.Value

Case a
ActiveSheets.Shapes.AddShape(msoShapeOval,159.75,29.25,15.75).Select
Selection.ShapeRange.Fill.Visible=msoFalse
Case 1
ActiveSheets.Shapes.AddShape(msoShapeOval,249.75,157.25,15.75).Select
Selection.ShapeRange.Fill.Visible=msoFalse
Case 2
ActiveSheets.Shapes.AddShape(msoShapeOval,343.75,29.25,15.75).Select
Selection.ShapeRange.Fill.Visible=msoFalse
Case 3
ActiveSheets.Shapes.AddShape(msoShapeOval,432.75,29.25,15.75).Select
Selection.ShapeRange.Fill.Visible=msoFalse
Case Else
MsgBox "データが空欄です"
End Select
Next

End Sub

【48807】Re:別のシートのデータを利用
発言  ichinose  - 07/5/10(木) 7:38 -

引用なし
パスワード
   ▼シスアド さん:
おはようございます。

>下記のように、セルBK2に0.1.2.3のいづれかが入力された場合Caseによって条件があるマクロを作成しました。
>これを同じSheetのリストという名前のセルBK2ではなく、データという名前のSheetのセルO2に値が入力されており、それを使用し、リストという名前に出力したいのですがどうしたらよいでしょうか?
>補足をお願いします。

>sub()
>a=0
>Dim c As Range
>
>For Each c ln Range("BK2")
>Select Case c.Value
>
>Case a
> ActiveSheets.Shapes.AddShape(msoShapeOval,159.75,29.25,15.75).Select
> Selection.ShapeRange.Fill.Visible=msoFalse
>Case 1
>ActiveSheets.Shapes.AddShape(msoShapeOval,249.75,157.25,15.75).Select
> Selection.ShapeRange.Fill.Visible=msoFalse
>Case 2
>ActiveSheets.Shapes.AddShape(msoShapeOval,343.75,29.25,15.75).Select
> Selection.ShapeRange.Fill.Visible=msoFalse
>Case 3
>ActiveSheets.Shapes.AddShape(msoShapeOval,432.75,29.25,15.75).Select
> Selection.ShapeRange.Fill.Visible=msoFalse
>Case Else
>MsgBox "データが空欄です"
>End Select
>Next
>End Sub
↑が変更前のコードということですが、これ正常に作動しませんよね!!

何故? という箇所がありますが、深い理由があるのだろうと
解釈し、そのまま残しました。

Sub sample()
  Dim a As Long
  Dim ok As Boolean
  Dim o_left As Double
  Dim o_top As Double
  Dim c As Range
  Set c = Worksheets("データ").Range("o2")
  a = 0
  ok = True
  Select Case c.Value
   Case ""
    MsgBox "データが空欄です"
    ok = False
   Case a
    o_left = 159.75
    o_top = 29.25
   Case 1
    o_left = 249.75
    o_top = 157.25
   Case 2
    o_left = 343.75
    o_top = 29.25
   Case 3
    o_left = 432.75
    o_top = 29.25
   Case Else
    MsgBox "データが無効です"
    ok = False
   End Select
  If ok = True Then
    With Worksheets("リスト").Shapes. _
      AddShape(msoShapeOval, o_left, o_top, 15.75, 15.75)
     .Parent.Select
     .Fill.Visible = msoFalse
     .Select
     End With
    End If
End Sub

【48827】Re:別のシートのデータを利用
発言  シスアド  - 07/5/10(木) 19:09 -

引用なし
パスワード
   回答ありがとうございます。

正常に動作しないということですが、
もしよろしければ教えてもらえないでしょうか?
お願いします。

▼ichinose さん:
>▼シスアド さん:
>おはようございます。
>
>>下記のように、セルBK2に0.1.2.3のいづれかが入力された場合Caseによって条件があるマクロを作成しました。
>>これを同じSheetのリストという名前のセルBK2ではなく、データという名前のSheetのセルO2に値が入力されており、それを使用し、リストという名前に出力したいのですがどうしたらよいでしょうか?
>>補足をお願いします。
>
>>sub()
>>a=0
>>Dim c As Range
>>
>>For Each c ln Range("BK2")
>>Select Case c.Value
>>
>>Case a
>> ActiveSheets.Shapes.AddShape(msoShapeOval,159.75,29.25,15.75).Select
>> Selection.ShapeRange.Fill.Visible=msoFalse
>>Case 1
>>ActiveSheets.Shapes.AddShape(msoShapeOval,249.75,157.25,15.75).Select
>> Selection.ShapeRange.Fill.Visible=msoFalse
>>Case 2
>>ActiveSheets.Shapes.AddShape(msoShapeOval,343.75,29.25,15.75).Select
>> Selection.ShapeRange.Fill.Visible=msoFalse
>>Case 3
>>ActiveSheets.Shapes.AddShape(msoShapeOval,432.75,29.25,15.75).Select
>> Selection.ShapeRange.Fill.Visible=msoFalse
>>Case Else
>>MsgBox "データが空欄です"
>>End Select
>>Next
>>End Sub
>↑が変更前のコードということですが、これ正常に作動しませんよね!!
>
>何故? という箇所がありますが、深い理由があるのだろうと
>解釈し、そのまま残しました。
>
>Sub sample()
>  Dim a As Long
>  Dim ok As Boolean
>  Dim o_left As Double
>  Dim o_top As Double
>  Dim c As Range
>  Set c = Worksheets("データ").Range("o2")
>  a = 0
>  ok = True
>  Select Case c.Value
>   Case ""
>    MsgBox "データが空欄です"
>    ok = False
>   Case a
>    o_left = 159.75
>    o_top = 29.25
>   Case 1
>    o_left = 249.75
>    o_top = 157.25
>   Case 2
>    o_left = 343.75
>    o_top = 29.25
>   Case 3
>    o_left = 432.75
>    o_top = 29.25
>   Case Else
>    MsgBox "データが無効です"
>    ok = False
>   End Select
>  If ok = True Then
>    With Worksheets("リスト").Shapes. _
>      AddShape(msoShapeOval, o_left, o_top, 15.75, 15.75)
>     .Parent.Select
>     .Fill.Visible = msoFalse
>     .Select
>     End With
>    End If
>End Sub

【48843】Re:別のシートのデータを利用
発言  ichinose  - 07/5/11(金) 7:31 -

引用なし
パスワード
   ▼シスアド さん:
おはようございます。

>
>正常に動作しないということですが、
>もしよろしければ教えてもらえないでしょうか?
何を「教える」のですか?

「正常に動作しない のは何故か?」

ということですか?

ならば、実行してみればわかると思いますが、

コンパルエラー(文法的に正しくない記述がいくつかあります)

となって動作しませんよね?
>>sub()
>>a=0
>>Dim c As Range
>>
>>For Each c ln Range("BK2")
>>Select Case c.Value
>>
>>Case a
>> ActiveSheets.Shapes.AddShape(msoShapeOval,159.75,29.25,15.75).Select
>> Selection.ShapeRange.Fill.Visible=msoFalse
>>Case 1
>>ActiveSheets.Shapes.AddShape(msoShapeOval,249.75,157.25,15.75).Select
>> Selection.ShapeRange.Fill.Visible=msoFalse
>>Case 2
>>ActiveSheets.Shapes.AddShape(msoShapeOval,343.75,29.25,15.75).Select
>> Selection.ShapeRange.Fill.Visible=msoFalse
>>Case 3
>>ActiveSheets.Shapes.AddShape(msoShapeOval,432.75,29.25,15.75).Select
>> Selection.ShapeRange.Fill.Visible=msoFalse
>>Case Else
>>MsgBox "データが空欄です"
>>End Select
>>Next
>>End Sub
 

Sub sample() 'プロシジャーの名前を付けないとエラーになります。文法です
  Dim a As Long 'データ宣言すること
  Dim c As Range
  a = 0
'セルBK2単独の値だけで処理させるのですから、For each文は要らないですよね?
  Set c = Range("bk2")
  Select Case c.Value
    Case a
     ActiveSheet.Shapes.AddShape( _
       msoShapeOval, 159.75, 29.25, 15.75, 15.75).Select
'Activesheetsというプロパティはありませんし、
'Addshapeメソッドのオプションの数が足りません
     Selection.ShapeRange.Fill.Visible = msoFalse
    Case 1
     ActiveSheet.Shapes.AddShape( _
       msoShapeOval, 249.75, 157.25, 15.75, 15.75).Select
     Selection.ShapeRange.Fill.Visible = msoFalse
    Case 2
     ActiveSheet.Shapes.AddShape( _
       msoShapeOval, 343.75, 29.25, 15.75, 15.75).Select
     Selection.ShapeRange.Fill.Visible = msoFalse
    Case 3
     ActiveSheet.Shapes.AddShape( _
       msoShapeOval, 432.75, 29.25, 15.75, 15.75).Select
     Selection.ShapeRange.Fill.Visible = msoFalse
    Case Else
     MsgBox "データが無効です"
'セルBK2は空欄でもこのケースには入ってきませんよ!!
    End Select
End Sub

と出来るかぎりシスアド さんのコードを残すように修正しました。
元コードと比較してください。


私が提示したコードも試して見てください。

シート名が正しければ、作動するはずですよ!!


>>何故? という箇所がありますが、深い理由があるのだろうと
>>解釈し、そのまま残しました。
>>
>>Sub sample()
>>  Dim a As Long
>>  Dim ok As Boolean
>>  Dim o_left As Double
>>  Dim o_top As Double
>>  Dim c As Range
>>  Set c = Worksheets("データ").Range("o2")
>>  a = 0
>>  ok = True
>>  Select Case c.Value
>>   Case ""
>>    MsgBox "データが空欄です"
>>    ok = False
>>   Case a
>>    o_left = 159.75
>>    o_top = 29.25
>>   Case 1
>>    o_left = 249.75
>>    o_top = 157.25
>>   Case 2
>>    o_left = 343.75
>>    o_top = 29.25
>>   Case 3
>>    o_left = 432.75
>>    o_top = 29.25
>>   Case Else
>>    MsgBox "データが無効です"
>>    ok = False
>>   End Select
>>  If ok = True Then
>>    With Worksheets("リスト").Shapes. _
>>      AddShape(msoShapeOval, o_left, o_top, 15.75, 15.75)
>>     .Parent.Select
>>     .Fill.Visible = msoFalse
>>     .Select
>>     End With
>>    End If
>>End Sub

【48857】Re:別のシートのデータを利用
発言  シスアド  - 07/5/11(金) 23:16 -

引用なし
パスワード
   ご指摘ありがとうございます。

目的としては、単独で動作させるのが目的ではないんですけど
最終的には、データがBK2だけではなく縦にBK3BK4・・・と複数入れて
BK2は、sheet3,BK3はsheet4・・・というふうに実行結果を出力させていく
その時のsheetはデータがある数だけ作られるというようにしたいのですが・・・
意味が伝わりましたかね?わからなければいってください。
▼ichinose さん:
>▼シスアド さん:
>おはようございます。
>
>>
>>正常に動作しないということですが、
>>もしよろしければ教えてもらえないでしょうか?
>何を「教える」のですか?
>
>「正常に動作しない のは何故か?」
>
>ということですか?
>
>ならば、実行してみればわかると思いますが、
>
>コンパルエラー(文法的に正しくない記述がいくつかあります)
>
>となって動作しませんよね?
>>>sub()
>>>a=0
>>>Dim c As Range
>>>
>>>For Each c ln Range("BK2")
>>>Select Case c.Value
>>>
>>>Case a
>>> ActiveSheets.Shapes.AddShape(msoShapeOval,159.75,29.25,15.75).Select
>>> Selection.ShapeRange.Fill.Visible=msoFalse
>>>Case 1
>>>ActiveSheets.Shapes.AddShape(msoShapeOval,249.75,157.25,15.75).Select
>>> Selection.ShapeRange.Fill.Visible=msoFalse
>>>Case 2
>>>ActiveSheets.Shapes.AddShape(msoShapeOval,343.75,29.25,15.75).Select
>>> Selection.ShapeRange.Fill.Visible=msoFalse
>>>Case 3
>>>ActiveSheets.Shapes.AddShape(msoShapeOval,432.75,29.25,15.75).Select
>>> Selection.ShapeRange.Fill.Visible=msoFalse
>>>Case Else
>>>MsgBox "データが空欄です"
>>>End Select
>>>Next
>>>End Sub
> 
>
>Sub sample() 'プロシジャーの名前を付けないとエラーになります。文法です
>  Dim a As Long 'データ宣言すること
>  Dim c As Range
>  a = 0
>'セルBK2単独の値だけで処理させるのですから、For each文は要らないですよね?
>  Set c = Range("bk2")
>  Select Case c.Value
>    Case a
>     ActiveSheet.Shapes.AddShape( _
>       msoShapeOval, 159.75, 29.25, 15.75, 15.75).Select
>'Activesheetsというプロパティはありませんし、
>'Addshapeメソッドのオプションの数が足りません
>     Selection.ShapeRange.Fill.Visible = msoFalse
>    Case 1
>     ActiveSheet.Shapes.AddShape( _
>       msoShapeOval, 249.75, 157.25, 15.75, 15.75).Select
>     Selection.ShapeRange.Fill.Visible = msoFalse
>    Case 2
>     ActiveSheet.Shapes.AddShape( _
>       msoShapeOval, 343.75, 29.25, 15.75, 15.75).Select
>     Selection.ShapeRange.Fill.Visible = msoFalse
>    Case 3
>     ActiveSheet.Shapes.AddShape( _
>       msoShapeOval, 432.75, 29.25, 15.75, 15.75).Select
>     Selection.ShapeRange.Fill.Visible = msoFalse
>    Case Else
>     MsgBox "データが無効です"
>'セルBK2は空欄でもこのケースには入ってきませんよ!!
>    End Select
>End Sub
>
>と出来るかぎりシスアド さんのコードを残すように修正しました。
>元コードと比較してください。
>
>
>私が提示したコードも試して見てください。
>
>シート名が正しければ、作動するはずですよ!!
>
>
>>>何故? という箇所がありますが、深い理由があるのだろうと
>>>解釈し、そのまま残しました。
>>>
>>>Sub sample()
>>>  Dim a As Long
>>>  Dim ok As Boolean
>>>  Dim o_left As Double
>>>  Dim o_top As Double
>>>  Dim c As Range
>>>  Set c = Worksheets("データ").Range("o2")
>>>  a = 0
>>>  ok = True
>>>  Select Case c.Value
>>>   Case ""
>>>    MsgBox "データが空欄です"
>>>    ok = False
>>>   Case a
>>>    o_left = 159.75
>>>    o_top = 29.25
>>>   Case 1
>>>    o_left = 249.75
>>>    o_top = 157.25
>>>   Case 2
>>>    o_left = 343.75
>>>    o_top = 29.25
>>>   Case 3
>>>    o_left = 432.75
>>>    o_top = 29.25
>>>   Case Else
>>>    MsgBox "データが無効です"
>>>    ok = False
>>>   End Select
>>>  If ok = True Then
>>>    With Worksheets("リスト").Shapes. _
>>>      AddShape(msoShapeOval, o_left, o_top, 15.75, 15.75)
>>>     .Parent.Select
>>>     .Fill.Visible = msoFalse
>>>     .Select
>>>     End With
>>>    End If
>>>End Sub

【48864】Re:別のシートのデータを利用
発言  ichinose  - 07/5/12(土) 17:55 -

引用なし
パスワード
   ▼シスアド さん:
こんにちは。

>目的としては、単独で動作させるのが目的ではないんですけど
>最終的には、データがBK2だけではなく縦にBK3BK4・・・と複数入れて
>BK2は、sheet3,BK3はsheet4・・・というふうに実行結果を出力させていく
>その時のsheetはデータがある数だけ作られるというようにしたいのですが・・・
>意味が伝わりましたかね?わからなければいってください。

はっきりではありませんが、何となくならわかります・・・が、

>>下記のように、セルBK2に0.1.2.3のいづれかが入力された場合Caseによって条件があ>>るマクロを作成しました。
>>これを同じSheetのリストという名前のセルBK2ではなく、データという名前のSheetの>>セルO2に値が入力されており、それを使用し、リストという名前に出力したいのですが>>どうしたらよいでしょうか?

最初の投稿の↑の仕様とは違いますね!!

マクロ実行前のシート構成

マクロを含むブックには、
  xxxxというシート名のシート
  yyyyというシート名のシート(複数あるならすべて記述)
  ・
  ・

というようにこんなところから 正確に記述してください。

特に今回は、シートを追加するのですよね?
だったら、どこに追加するかも正確に記述してください。


マクロの入力データに相当するデータの情報も正確に記述してください。
(まあ、これは、ある程度は記述されていましたが・・・)


このマクロの入力データに相当するデータは、
  シートxxxxというシート名のシートのセルBK2から決まった行数では
  ありませんが、入力されています。

    A   B ・・・・ BK
 1             作成位置指示
 2              1
 3              2
 4              0
 5              3
 6              1
 7              2

一例ですが、上記のように入力されています。
行数は、上記の例ではセルBK7までですが、一定ではありません。
3行の場合もあれば、20行の場合もあります。

シートxxxxのセルBK2以下のセルの値を基に
オートシェープの円を作成します。


作成するオートシェープの円の作成位置がセルの値によって違います。

又、セルBK2の値で作成するオートシェープの円は、

このシートxxxxに作成するのではなく、
新たに作成するシート(マクロで作成する)に作成します。

同様にBK3の値によって、作成するオートシェープの円も
別に新規作成されたシート上に作成します。

このようにシートxxxxのセルBK2以下にオートシェープの円の作成指示データが
ある限り新規にシートを作成し、
その作成されたシート上に作成指示データで示される位置に
オートシェープの円を作成します。

それぞれのシートに作成するオートシェープの円の作成位置は、

 作成指示データ   シートのLeft、シートのTop
    0        159.75    29.25
    1        249.75    157.25
    2        343.75    29.25
    3        432.75    29.25


上記のようになっています。


とこのような仕様でよいのですか?

だとしたら、シスアド さんこの程度の仕様の提示はしなければなりません。


このような仕様だとして・・・・。

・新規ブックにシートを1枚のみにしてください。
 (既定で、3枚作成されていても削除して1枚にしてください)

・この1枚シートのシート名はSheet1としてください。
 このシートのセルBK2以降に円の作成指示番号が入っているとします。
 
標準モジュールに
'===================================================================
Sub sample()
  Dim ok As Boolean
  Dim o_left As Double
  Dim o_top As Double
  Dim crng As Range
  Dim c As Range
  With Worksheets("sheet1")
    For Each c In .Range("bk2", .Cells(.Rows.Count, "bk").End(xlUp))
     ok = True
     Select Case c.Value
      Case 0
        o_left = 159.75
        o_top = 29.25
      Case 1
        o_left = 249.75
        o_top = 157.25
      Case 2
        o_left = 343.75
        o_top = 29.25
      Case 3
        o_left = 432.75
        o_top = 29.25
      Case Else
        ok = False
      End Select
     If ok = True Then
       With Worksheets.Add(after:=Worksheets(Worksheets.Count))
         .Name = "sheet" & c.Row
         DoEvents
         With .Shapes.AddShape(msoShapeOval, o_left, o_top, 15.75, 15.75)
           .Fill.Visible = msoFalse
           End With
         End With
       End If
     Next
    End With
End Sub


記述したようなシートの準備が出来たら、
上記のSampleを実行してみてください。

セルBk2から、BK7に上述のようなデータが入力されていた場合、

Sheet2からSheet7というシートが追加作成され、それぞれのシートに
指示データに対応した位置に円が作成されます。

【48871】Re:別のシートのデータを利用
お礼  シスアド  - 07/5/13(日) 20:00 -

引用なし
パスワード
   ▼ichinose さん:
こんばんわ。
わかりにくいのに理解していただいて本当に助かります。
ありがとうございました。
マクロを理解されていてすごいですね〜
勉強の仕方などあるのでしょうか?
なにかあったらまたよろしくお願いします。

>▼シスアド さん:
>こんにちは。
>
>>目的としては、単独で動作させるのが目的ではないんですけど
>>最終的には、データがBK2だけではなく縦にBK3BK4・・・と複数入れて
>>BK2は、sheet3,BK3はsheet4・・・というふうに実行結果を出力させていく
>>その時のsheetはデータがある数だけ作られるというようにしたいのですが・・・
>>意味が伝わりましたかね?わからなければいってください。
>
>はっきりではありませんが、何となくならわかります・・・が、
>
>>>下記のように、セルBK2に0.1.2.3のいづれかが入力された場合Caseによって条件があ>>るマクロを作成しました。
>>>これを同じSheetのリストという名前のセルBK2ではなく、データという名前のSheetの>>セルO2に値が入力されており、それを使用し、リストという名前に出力したいのですが>>どうしたらよいでしょうか?
>
>最初の投稿の↑の仕様とは違いますね!!
>
>マクロ実行前のシート構成
>
>マクロを含むブックには、
>  xxxxというシート名のシート
>  yyyyというシート名のシート(複数あるならすべて記述)
>  ・
>  ・
>
>というようにこんなところから 正確に記述してください。
>
>特に今回は、シートを追加するのですよね?
>だったら、どこに追加するかも正確に記述してください。
>
>
>マクロの入力データに相当するデータの情報も正確に記述してください。
>(まあ、これは、ある程度は記述されていましたが・・・)
>
>
>このマクロの入力データに相当するデータは、
>  シートxxxxというシート名のシートのセルBK2から決まった行数では
>  ありませんが、入力されています。
>
>    A   B ・・・・ BK
> 1             作成位置指示
> 2              1
> 3              2
> 4              0
> 5              3
> 6              1
> 7              2
>
>一例ですが、上記のように入力されています。
>行数は、上記の例ではセルBK7までですが、一定ではありません。
>3行の場合もあれば、20行の場合もあります。
>
>シートxxxxのセルBK2以下のセルの値を基に
>オートシェープの円を作成します。
>
>
>作成するオートシェープの円の作成位置がセルの値によって違います。
>
>又、セルBK2の値で作成するオートシェープの円は、
>
>このシートxxxxに作成するのではなく、
>新たに作成するシート(マクロで作成する)に作成します。
>
>同様にBK3の値によって、作成するオートシェープの円も
>別に新規作成されたシート上に作成します。
>
>このようにシートxxxxのセルBK2以下にオートシェープの円の作成指示データが
>ある限り新規にシートを作成し、
>その作成されたシート上に作成指示データで示される位置に
>オートシェープの円を作成します。
>
>それぞれのシートに作成するオートシェープの円の作成位置は、
>
> 作成指示データ   シートのLeft、シートのTop
>    0        159.75    29.25
>    1        249.75    157.25
>    2        343.75    29.25
>    3        432.75    29.25
>
>
>上記のようになっています。
>
>
>とこのような仕様でよいのですか?
>
>だとしたら、シスアド さんこの程度の仕様の提示はしなければなりません。
>
>
>このような仕様だとして・・・・。
>
>・新規ブックにシートを1枚のみにしてください。
> (既定で、3枚作成されていても削除して1枚にしてください)
>
>・この1枚シートのシート名はSheet1としてください。
> このシートのセルBK2以降に円の作成指示番号が入っているとします。
> 
>標準モジュールに
>'===================================================================
>Sub sample()
>  Dim ok As Boolean
>  Dim o_left As Double
>  Dim o_top As Double
>  Dim crng As Range
>  Dim c As Range
>  With Worksheets("sheet1")
>    For Each c In .Range("bk2", .Cells(.Rows.Count, "bk").End(xlUp))
>     ok = True
>     Select Case c.Value
>      Case 0
>        o_left = 159.75
>        o_top = 29.25
>      Case 1
>        o_left = 249.75
>        o_top = 157.25
>      Case 2
>        o_left = 343.75
>        o_top = 29.25
>      Case 3
>        o_left = 432.75
>        o_top = 29.25
>      Case Else
>        ok = False
>      End Select
>     If ok = True Then
>       With Worksheets.Add(after:=Worksheets(Worksheets.Count))
>         .Name = "sheet" & c.Row
>         DoEvents
>         With .Shapes.AddShape(msoShapeOval, o_left, o_top, 15.75, 15.75)
>           .Fill.Visible = msoFalse
>           End With
>         End With
>       End If
>     Next
>    End With
>End Sub
>
>
>記述したようなシートの準備が出来たら、
>上記のSampleを実行してみてください。
>
>セルBk2から、BK7に上述のようなデータが入力されていた場合、
>
>Sheet2からSheet7というシートが追加作成され、それぞれのシートに
>指示データに対応した位置に円が作成されます。

【48874】Re:別のシートのデータを利用
質問  シスアド  - 07/5/13(日) 21:02 -

引用なし
パスワード
   すいません、もう1つ教えてもらいたいのですが

 A   B ・・ BJ ・・     BK
 1        作成位置指示2    作成位置指示
 2        3           1
 3        2           2
 4        1           0
 5        2           3
 6        2           1 
 7        3           2

上記のように作成位置指示2を追加して、BKで作成したsheet名とそれぞれ同じsheetにBJの円作成ができないでしょうか?
これは、BKでつくったsheet上に追加するんではなく、同時BJ・BK同時に円を作成したいのですが。。。
BJの円作成位置は適当に決めてもらってかまいません。
▼ichinose さん:
>▼シスアド さん:
>こんにちは。
>
>>目的としては、単独で動作させるのが目的ではないんですけど
>>最終的には、データがBK2だけではなく縦にBK3BK4・・・と複数入れて
>>BK2は、sheet3,BK3はsheet4・・・というふうに実行結果を出力させていく
>>その時のsheetはデータがある数だけ作られるというようにしたいのですが・・・
>>意味が伝わりましたかね?わからなければいってください。
>
>はっきりではありませんが、何となくならわかります・・・が、
>
>>>下記のように、セルBK2に0.1.2.3のいづれかが入力された場合Caseによって条件があ>>るマクロを作成しました。
>>>これを同じSheetのリストという名前のセルBK2ではなく、データという名前のSheetの>>セルO2に値が入力されており、それを使用し、リストという名前に出力したいのですが>>どうしたらよいでしょうか?
>
>最初の投稿の↑の仕様とは違いますね!!
>
>マクロ実行前のシート構成
>
>マクロを含むブックには、
>  xxxxというシート名のシート
>  yyyyというシート名のシート(複数あるならすべて記述)
>  ・
>  ・
>
>というようにこんなところから 正確に記述してください。
>
>特に今回は、シートを追加するのですよね?
>だったら、どこに追加するかも正確に記述してください。
>
>
>マクロの入力データに相当するデータの情報も正確に記述してください。
>(まあ、これは、ある程度は記述されていましたが・・・)
>
>
>このマクロの入力データに相当するデータは、
>  シートxxxxというシート名のシートのセルBK2から決まった行数では
>  ありませんが、入力されています。
>
>    A   B ・・・・ BK
> 1             作成位置指示
> 2              1
> 3              2
> 4              0
> 5              3
> 6              1
> 7              2
>
>一例ですが、上記のように入力されています。
>行数は、上記の例ではセルBK7までですが、一定ではありません。
>3行の場合もあれば、20行の場合もあります。
>
>シートxxxxのセルBK2以下のセルの値を基に
>オートシェープの円を作成します。
>
>
>作成するオートシェープの円の作成位置がセルの値によって違います。
>
>又、セルBK2の値で作成するオートシェープの円は、
>
>このシートxxxxに作成するのではなく、
>新たに作成するシート(マクロで作成する)に作成します。
>
>同様にBK3の値によって、作成するオートシェープの円も
>別に新規作成されたシート上に作成します。
>
>このようにシートxxxxのセルBK2以下にオートシェープの円の作成指示データが
>ある限り新規にシートを作成し、
>その作成されたシート上に作成指示データで示される位置に
>オートシェープの円を作成します。
>
>それぞれのシートに作成するオートシェープの円の作成位置は、
>
> 作成指示データ   シートのLeft、シートのTop
>    0        159.75    29.25
>    1        249.75    157.25
>    2        343.75    29.25
>    3        432.75    29.25
>
>
>上記のようになっています。
>
>
>とこのような仕様でよいのですか?
>
>だとしたら、シスアド さんこの程度の仕様の提示はしなければなりません。
>
>
>このような仕様だとして・・・・。
>
>・新規ブックにシートを1枚のみにしてください。
> (既定で、3枚作成されていても削除して1枚にしてください)
>
>・この1枚シートのシート名はSheet1としてください。
> このシートのセルBK2以降に円の作成指示番号が入っているとします。
> 
>標準モジュールに
>'===================================================================
>Sub sample()
>  Dim ok As Boolean
>  Dim o_left As Double
>  Dim o_top As Double
>  Dim crng As Range
>  Dim c As Range
>  With Worksheets("sheet1")
>    For Each c In .Range("bk2", .Cells(.Rows.Count, "bk").End(xlUp))
>     ok = True
>     Select Case c.Value
>      Case 0
>        o_left = 159.75
>        o_top = 29.25
>      Case 1
>        o_left = 249.75
>        o_top = 157.25
>      Case 2
>        o_left = 343.75
>        o_top = 29.25
>      Case 3
>        o_left = 432.75
>        o_top = 29.25
>      Case Else
>        ok = False
>      End Select
>     If ok = True Then
>       With Worksheets.Add(after:=Worksheets(Worksheets.Count))
>         .Name = "sheet" & c.Row
>         DoEvents
>         With .Shapes.AddShape(msoShapeOval, o_left, o_top, 15.75, 15.75)
>           .Fill.Visible = msoFalse
>           End With
>         End With
>       End If
>     Next
>    End With
>End Sub
>
>
>記述したようなシートの準備が出来たら、
>上記のSampleを実行してみてください。
>
>セルBk2から、BK7に上述のようなデータが入力されていた場合、
>
>Sheet2からSheet7というシートが追加作成され、それぞれのシートに
>指示データに対応した位置に円が作成されます。

【48878】Re:別のシートのデータを利用
発言  ichinose  - 07/5/14(月) 8:59 -

引用なし
パスワード
   ▼シスアド さん:
おはようございます。

>すいません、もう1つ教えてもらいたいのですが
>
> A   B ・・ BJ ・・     BK
> 1        作成位置指示2    作成位置指示
> 2        3           1
> 3        2           2
> 4        1           0
> 5        2           3
> 6        2           1 
> 7        3           2
>
>上記のように作成位置指示2を追加して、BKで作成したsheet名とそれぞれ同じsheetにBJの円作成ができないでしょうか?
>これは、BKでつくったsheet上に追加するんではなく、同時BJ・BK同時に円を作成したいのですが。。。
>BJの円作成位置は適当に決めてもらってかまいません。
いいえ、これもシスアド さん本来は、記述してください。


>>
>>・新規ブックにシートを1枚のみにしてください。
>> (既定で、3枚作成されていても削除して1枚にしてください)
>>
>>・この1枚シートのシート名はSheet1としてください。
>> このシートのセルBK2以降に円の作成指示番号が入っているとします。

↑この前提は、今回も同じです

上記のような新規ブックの標準モジュールに

'===============================================================
Option Explicit
Sub sample()
  Dim BKdx As Variant
  Dim BJdx As Variant
  Dim c As Range
  Dim BKarray As Variant
  Dim BJarray As Variant
  BKarray = Evaluate( _
         "transpose({0,1,2,3;" & _
         "159.75,249.75,343.75,432.75;" & _
         "29.25,157.25,29.25,29.25})")
  BJarray = Evaluate( _
         "transpose({0,1,2,3;" & _
         "100,150,200,250;" & _
         "30,100,80,25})")
  '↑これが、BK列、BJ列の数値に対応する円の作成位置を表すマスターデータです。
  '本来なら、シート上に配置するのが良いと思います。そうすれば、データの変更や追加があっても
  'コードの変更が要りません
  With Worksheets("sheet1")
    For Each c In .Range("bk2", .Cells(.Rows.Count, "bk").End(xlUp))
     With Application
       BKdx = .Match(Val(c.Value), .Index(BKarray, 0, 1), 0)
       End With
     With Application
       BJdx = .Match(Val(c.Offset(0, -1).Value), .Index(BJarray, 0, 1), 0)
       End With
     If (Not IsError(BKdx)) Or (Not IsError(BJdx)) Then
       With Worksheets.Add(after:=Worksheets(Worksheets.Count))
         .Name = "sheet" & c.Row
         DoEvents
         If Not IsError(BKdx) Then
           With .Shapes.AddShape(msoShapeOval, _
              BKarray(BKdx, 2), BKarray(BKdx, 3), 15.75, 15.75)
            .Fill.Visible = msoFalse
            End With
           End If
         If Not IsError(BJdx) Then
           With .Shapes.AddShape(msoShapeOval, _
              BJarray(BJdx, 2), BJarray(BJdx, 3), 15.75, 15.75)
            .Fill.Visible = msoTrue
            .Fill.ForeColor.SchemeColor = 15
            .Fill.Transparency = 0.51
            End With
           End If
         End With
       End If
     Next
    End With
End Sub


>>
BK列、BJ列に円の作成位置データを配置し(それぞれ2行目から)、
>>上記のSampleを実行してみてください。

尚、作成位置データの入力範囲は、BK列を基準に取得しています。


大きく、コードを変更しました。
当初は、シスアド さんのコードを少しでも残す方向でコードを書きましたが、
本来なら、今回のような事象では、私は、Case文を使いません。
(コードの変更をなるべく少なくしたい という理由からです)

試してみてください。そして、コードは、前回より、難しいですが、
HELP等を使ってじっくり解読してください。
特に配列とワークシート関数の知識が必要です。

その上で不明な点があれば今度は、ピンポイントで質問してください。

【48941】Re:別のシートのデータを利用
お礼  シスアド  - 07/5/16(水) 19:27 -

引用なし
パスワード
   ありがとうございました。
勉強してみます。
なにかありましたらよろしくお願いします。
▼ichinose さん:
>▼シスアド さん:
>おはようございます。
>
>>すいません、もう1つ教えてもらいたいのですが
>>
>> A   B ・・ BJ ・・     BK
>> 1        作成位置指示2    作成位置指示
>> 2        3           1
>> 3        2           2
>> 4        1           0
>> 5        2           3
>> 6        2           1 
>> 7        3           2
>>
>>上記のように作成位置指示2を追加して、BKで作成したsheet名とそれぞれ同じsheetにBJの円作成ができないでしょうか?
>>これは、BKでつくったsheet上に追加するんではなく、同時BJ・BK同時に円を作成したいのですが。。。
>>BJの円作成位置は適当に決めてもらってかまいません。
>いいえ、これもシスアド さん本来は、記述してください。
>
>
>>>
>>>・新規ブックにシートを1枚のみにしてください。
>>> (既定で、3枚作成されていても削除して1枚にしてください)
>>>
>>>・この1枚シートのシート名はSheet1としてください。
>>> このシートのセルBK2以降に円の作成指示番号が入っているとします。
>
>↑この前提は、今回も同じです
>
>上記のような新規ブックの標準モジュールに
>
>'===============================================================
>Option Explicit
>Sub sample()
>  Dim BKdx As Variant
>  Dim BJdx As Variant
>  Dim c As Range
>  Dim BKarray As Variant
>  Dim BJarray As Variant
>  BKarray = Evaluate( _
>         "transpose({0,1,2,3;" & _
>         "159.75,249.75,343.75,432.75;" & _
>         "29.25,157.25,29.25,29.25})")
>  BJarray = Evaluate( _
>         "transpose({0,1,2,3;" & _
>         "100,150,200,250;" & _
>         "30,100,80,25})")
>  '↑これが、BK列、BJ列の数値に対応する円の作成位置を表すマスターデータです。
>  '本来なら、シート上に配置するのが良いと思います。そうすれば、データの変更や追加があっても
>  'コードの変更が要りません
>  With Worksheets("sheet1")
>    For Each c In .Range("bk2", .Cells(.Rows.Count, "bk").End(xlUp))
>     With Application
>       BKdx = .Match(Val(c.Value), .Index(BKarray, 0, 1), 0)
>       End With
>     With Application
>       BJdx = .Match(Val(c.Offset(0, -1).Value), .Index(BJarray, 0, 1), 0)
>       End With
>     If (Not IsError(BKdx)) Or (Not IsError(BJdx)) Then
>       With Worksheets.Add(after:=Worksheets(Worksheets.Count))
>         .Name = "sheet" & c.Row
>         DoEvents
>         If Not IsError(BKdx) Then
>           With .Shapes.AddShape(msoShapeOval, _
>              BKarray(BKdx, 2), BKarray(BKdx, 3), 15.75, 15.75)
>            .Fill.Visible = msoFalse
>            End With
>           End If
>         If Not IsError(BJdx) Then
>           With .Shapes.AddShape(msoShapeOval, _
>              BJarray(BJdx, 2), BJarray(BJdx, 3), 15.75, 15.75)
>            .Fill.Visible = msoTrue
>            .Fill.ForeColor.SchemeColor = 15
>            .Fill.Transparency = 0.51
>            End With
>           End If
>         End With
>       End If
>     Next
>    End With
>End Sub
>
>
>>>
>BK列、BJ列に円の作成位置データを配置し(それぞれ2行目から)、
>>>上記のSampleを実行してみてください。
>
>尚、作成位置データの入力範囲は、BK列を基準に取得しています。
>
>
>大きく、コードを変更しました。
>当初は、シスアド さんのコードを少しでも残す方向でコードを書きましたが、
>本来なら、今回のような事象では、私は、Case文を使いません。
>(コードの変更をなるべく少なくしたい という理由からです)
>
>試してみてください。そして、コードは、前回より、難しいですが、
>HELP等を使ってじっくり解読してください。
>特に配列とワークシート関数の知識が必要です。
>
>その上で不明な点があれば今度は、ピンポイントで質問してください。

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