Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7791 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【36852】Arrayで作成したいのですが・・・ Mik 06/4/16(日) 10:55 質問[未読]
【36853】Re:Arrayで作成したいのですが・・・ ponpon 06/4/16(日) 12:08 発言[未読]
【36855】Re:Arrayで作成したいのですが・・・ Mik 06/4/16(日) 16:39 お礼[未読]
【36854】Re:Arrayで作成したいのですが・・・ Kein 06/4/16(日) 13:48 回答[未読]
【36856】Re:Arrayで作成したいのですが・・・ Mik 06/4/16(日) 16:47 お礼[未読]
【36852】Arrayで作成したいのですが・・・
質問  Mik  - 06/4/16(日) 10:55 -
引用なし
パスワード
   雛形のシート増とシート名設定について

"作業シート"　A列に次のようにシート名が書かれていますが、
一部シート名が歯抜けになっている場合(10行目のように）、
"売上実績"（雛形）のシートコピーを増やし、シート名を
それぞれシートタブに表示するコードを作成しました。
（シート名の数は増減します)

これをArrayを使った構文に作成する事が出来ましたら
アドバイスいただけませんでしょうか？

作業シート
　　　　A　　　　　　　B
5　　シート名
6　　AAA
7　　BBB
8　　CCC
9　　DDD
10　　　
11　 GGG
12　 PPP
：　　　：
：　　　：

Sub　売上実績表のコピー()
Dim MyR As Range
Dim R 　　As Range

Set MyR = Range("A6", Cells(Rows.Count, 1).End(xlUp))

For Each R In MyR
　　If R.Value = "" Then
　　　　R.Offset(1).Select
　　　　MyR = MyR - 1
　　End If

　 On Error Resume Next
　　If R.Value = "" Then
　　　　Sheets("売上実績").Copy Nothing
　　Else
　　　　Sheets("売上実績").Copy after:=ActiveSheet
　　End If
　　　 ActiveSheet.Name = R.Value
Next R
　　On Error GoTo 0
Worksheets("作業シート").Activate

End Sub
【36853】Re:Arrayで作成したいのですが・・・
発言  ponpon  - 06/4/16(日) 12:08 -
引用なし
パスワード
   >雛形のシート増とシート名設定について
>
>"作業シート"　A列に次のようにシート名が書かれていますが、
>一部シート名が歯抜けになっている場合(10行目のように）、
>"売上実績"（雛形）のシートコピーを増やし、シート名を
>それぞれシートタブに表示するコードを作成しました。
>（シート名の数は増減します)
>
>これをArrayを使った構文に作成する事が出来ましたら
>アドバイスいただけませんでしょうか？

Arrayを使った構文を配列を使ってというように解釈して
方法はいろいろあると思いますが、・・・
Dictionaryを使って考えてみました

Sub test()
　　
　　Dim WS　　As Worksheet
　　Dim myDic As Object
　　Dim myKey As Variant
　　Dim r　　 As Range
　　
　　Application.ScreenUpdating = False
　　
　　'作業シート、売上実績以外のシートの削除
　　For Each WS In ThisWorkbook.Worksheets
　　　 If WS.Name = "作業シート" Or WS.Name = "売上実績" Then
　　　 Else
　　　　　Application.DisplayAlerts = False
　　　　　WS.Delete
　　　　　Application.DisplayAlerts = True
　　　 End If
　　Next
　　
　　　　'辞書にA列のシート名をKeyにして入れ配列の作成
　　Set myDic = CreateObject("Scripting.Dictionary")
　　With Sheets("作業シート")
　　　　For Each r In .Range("A6", .Range("A65536").End(xlUp))
　　　　　 If Not IsEmpty(r.Value) Then
　　　　　　 myDic(r.Value) = Empty
　　　　　 End If
　　　　Next
　　　　
　　　　'辞書が0でなかったら、売上実績をコピーして、名前をKeyにする
　　　　If myDic.Count > 0 Then
　　　　　　For Each myKey In myDic.Keys
　　　　　　　 Sheets("売上実績").Copy after:=ActiveSheet
　　　　　　　 ActiveSheet.Name = myKey
　　　　　　Next
　　　　End If
　　End With
　　Application.ScreenUpdating = True

End Sub
【36854】Re:Arrayで作成したいのですが・・・
回答  Kein  - 06/4/16(日) 13:48 -
引用なし
パスワード
   そんな無茶苦茶なコードは、絶対に動きませんよ。基本も勉強しないまま、
思いつきでタイプしたようなコードです。自分でコメントを付けてみて
そのとおりの意味になっているか、掲示板で尋ねてみるとよく分かると思います。
作業シートのA6以下に「値が入力されているところだけ」を抽出して、それを
コピーしたシートのシート名にするなら・・

Dim C As Range

Application.ScreenUpdating = False
With Sheets("作業シート")
　 For Each C In .Range("A6", .Range("A65556).End(xlUp)) _
　 .SpecialCells(2)
　　　Sheets("売上実績").Copy After:=ActiveSheet
　　　ActiveSheet.Name = C.Text
　 Next
　 .Activate
End With
Application.ScreenUpdating = True
【36855】Re:Arrayで作成したいのですが・・・
お礼  Mik  - 06/4/16(日) 16:39 -
引用なし
パスワード
   ▼ponpon さん：

早速のご回答ありがとうございました。
非常に参考になりました。
今までは、シートの増設と以前のシートの削除を別個に
していました。

一度にできるので便利です。ありがとうございました。
今後ともよろしくお願いします。
【36856】Re:Arrayで作成したいのですが・・・
お礼  Mik  - 06/4/16(日) 16:47 -
引用なし
パスワード
   ▼Kein さん：

>そんな無茶苦茶なコードは、絶対に動きませんよ。基本も勉強しないまま、
>思いつきでタイプしたようなコードです。

ご指摘ありがとうございます。
今までこのコードを使っていたもので、今回Keinさんのこのコードを参考に
またponponさんからご回答を参考に検討し直します。

ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7791 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free