こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

エクセルVBA 無駄な部分をおしえてください

VBA初心者です。
多数のシートを条件によって二つのブックに分ける、というVBAを作ろうとしています。
なにぶん素人なので、無駄な文章が多いのではないかと心配で、
お知恵を拝借できればと思い投稿いたしました。どうぞよろしくお願いいたします。

やりたいこと:Book1のA列に100程度の文字列があり、そのいずれかと一致するシート名(Book1のSheets(2)以降)を持つシートはBook2の最終シートの後ろへ、どの文字列ともシート名が一致しないシートはBook3の最終シートの後ろへ移動。(「最終シートの後ろへ移動」がうまくいっていません)

VBAの内容:Book1のH1に「=countif(A:A,G1)」と入力しておき、G1にシート名を入力させ
H1>0ならば該当シートをBook2へ、それ以外はBook3へ移動 の繰り返し

  Application.ScreenUpdating = False

Dim j As Integer, k As Integer
j = Workbooks("Book2.xls").Worksheets.Count
k = Workbooks("Book3.xls").Worksheets.Count

Do While Workbooks("Book1.xls").Sheets.Count > 1
Range("G1").Value = Worksheets(2).Name
If Range("H1").Value > 0 Then
Worksheets(2).Move after:=Workbooks("Book2.xls").Sheets(j)
Else
Worksheets(2).Move after:=Workbooks("Book3.xls").Sheets(k)
End If

Loop

投稿日時 - 2011-01-04 12:34:06

QNo.6424486

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

-広告-
-広告-

回答(5)

ANo.5

微妙な部分なハードルになる部分がいくつもあるようですね。その分、難しいような気がします。
質問のコードとしては、アイデアとしては悪くないものの、今の段階では、完成できないような気がします。

注意:ブック名、シート名は、明示的に入れてください。ただし、wb1.Sheets(1) とwb1.Worksheets("Sheet1") は、同じものとします。それが違いますと、成功しません。なお、Sheets とWorksheets は、同じようでいて違いますから、注意が必要です。

'//標準モジュールが良い
Sub Test2()
 Dim i As Long
 Dim j As Long, k As Long
 Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
 Dim sh1 As Sheet1
 
 Set wb1 = ThisWorkbook
 Set wb2 = Workbooks("Book2.xls")
 Set wb3 = Workbooks("Book3.xls")
 Set sh1 = wb1.Worksheets("Sheet1")
 
 j = wb2.Sheets.Count: k = wb3.Sheets.Count
 'Application.ScreenUpdating = False '*
 For i = wb1.Sheets.Count To 2 Step -1
  'あり
  If Application.CountIf(sh1.Columns(1), wb1.Sheets(i).Name) > 0 Then
   wb1.Worksheets(i).Move After:=wb2.Sheets(j)
  Else
   'なし
   wb1.Worksheets(i).Move After:=wb3.Sheets(k)
  End If
 Next
 'Application.ScreenUpdating = True '*
 wb1.Activate
 Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
End Sub


*確認したら、外してください。

投稿日時 - 2011-01-04 16:39:05

お礼

>微妙な部分なハードルになる部分がいくつもあるようですね。
そうなんですよね~。微妙な部分がわかるセンスがほしいです。。。
やはり基礎からきっちり勉強しないとだめですね。

コードありがとうございました。
とても勉強になりました。

投稿日時 - 2011-01-04 17:18:03

ANo.4

ああ、ありがとう。そうか、ブックアクティブの問題だな。2度目の回答、役に立たなくてすまん。

投稿日時 - 2011-01-04 16:04:43

お礼

>前回最後にブックを保存したときの状態)でブックを認識するんよ。
なるほど、そりゃそうですね。気づきませんでした。

役に立たないなんてとんでもないです!
貴重な知識を伝授していただき本当にありがたいです。
また何かありましたら相談に参りますので、是非よろしくお願いいたします。

投稿日時 - 2011-01-04 16:29:51

ANo.3

▲Range("G1").Value = ●Worksheets(2).Name
If ▲Range("H1").Value > 0 Then
●Worksheets(2).Move after:=Workbooks("Book2.xls").Sheets(j)
Else
●Worksheets(2).Move after:=Workbooks("Book3.xls").Sheets(k)
End If

▲や●の部分にブック名やシート名が省略されてるので
それぞれはアクティブブック、アクティブシートを扱っていることになる
よって、2回目以降はうまくいかない。

Workbooks("Book1.xls").Sheets(1)   '▲部分に付加
Workbooks("Book1.xls")         '●部分に付加

---------------------------------------

ブック名、シート名を付加しないのなら
Do Whileの次か、最後のLoopの前に、

Workbooks("Book1.xls").Activate

を入れてBook1.xlsをいちいちアクティブする必要がある。
---------------------------------------------


ふつうはG1,H1を使用しないで。。。
--------------------------------------------
Sub test()
 Application.ScreenUpdating = False
 Dim Cnt As Integer
 Dim BK1 As Workbook

 Set BK1 = Workbooks("Book1.xls")

Do While BK1.Worksheets.Count > 1
 If WorksheetFunction.CountIf(BK1.Sheets(1).Range("A:A"), BK1.Sheets(2).Name) Then
   Cnt = Workbooks("Book2.xls").Sheets.Count
   BK1.Sheets(2).Move after:=Workbooks("Book2.xls").Sheets(Cnt)
 Else
   Cnt = Workbooks("Book3.xls").Sheets.Count
   BK1.Sheets(2).Move after:=Workbooks("Book3.xls").Sheets(Cnt)
 End If
Loop

Application.ScreenUpdating = True
End Sub
'----------------------------------------

以上です。

投稿日時 - 2011-01-04 15:17:27

お礼

スマートですねー。
わざわざコードを書いていただき、本当にありがとうございます。
今回の問題のためだけでなく、勉強になりました。
自力でここまで書けるようになるよう精進いたします!
また何かありましたら相談させてください。
ありがとうございました!!

投稿日時 - 2011-01-04 16:34:33

ANo.2

それは多分、ブックを保存しないまま続けてコードを動かすから。

保存しないと、コンピュータ側ではコードを動かす前の状態(前回最後にブックを保存したときの状態)でブックを認識するんよ。だから、2度目にコードを動かすと、「あれ、シート数が違うやん」てコンピュータがずっこける。

コード動かしたらBook2とBook3を保存してみ?そしたら続けて使えるはずだ。うまくいったら、VBAコードの最後のほうにSaveメソッド加えるといい。コンピュータが勝手にブック保存してくれるようになるから。

投稿日時 - 2011-01-04 14:23:55

ANo.1

無駄に思える部分があっても、思ったとおりに動くコードが一番でないかい?

いっこだけ、うまくいってないて部分についてアドバイスすれば、j =とk =の2行をDo Whileの次行に移してみ?

投稿日時 - 2011-01-04 12:49:02

お礼

さっそくご回答いただきありがとうございます。
なるほど、うまくいきました! 順番が間違っていたんですね。たすかりました。

すみません、追加でご相談なのですが、
3ブックを開いて最初の処理はうまくいくのですが
2度目、3度目と続けて実行していると「Moveメソッドに失敗しました」というようなエラー表示が出て、Book2にシートを移動させたあたりでとまってしまいます。

これは何が原因なのでしょうか。

投稿日時 - 2011-01-04 13:40:14

-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-