Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
10178 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【23197】複数のファイルの作業 あいんすと 05/3/16(水) 0:58 質問[未読]
【23199】Re:複数のファイルの作業 かみちゃん 05/3/16(水) 6:35 発言[未読]
【23236】Re:複数のファイルの作業 あいんすと 05/3/16(水) 23:24 質問[未読]
【23241】Re:複数のファイルの作業 かみちゃん 05/3/17(木) 6:49 回答[未読]
【23242】Re:複数のファイルの作業 かみちゃん 05/3/17(木) 7:08 回答[未読]
【23254】フォルダの有無 あいんすと 05/3/17(木) 13:08 質問[未読]
【23255】Re:フォルダの有無 かみちゃん 05/3/17(木) 13:52 回答[未読]
【23273】Re:フォルダの有無 あいんすと 05/3/18(金) 0:12 お礼[未読]
【23197】複数のファイルの作業
質問  あいんすと  - 05/3/16(水) 0:58 -
引用なし
パスワード
   ある範囲のデータを抽出するマクロを作ったのですが、
Personal.xlsで作ったので現在開いているウインドウのみの対象です。

この作業マクロを最初に指定したフォルダにある複数のファイルを指定して、同じ範囲のデータを抽出する作業をさせたいのですが、出来ますでしょうか？

ファイルを開かずに出来ればいいのですが、Openメソッドだと、1つのファイルしか開けませんし、複数のファイルのをどうやって順番に作業させて良いのかわかりません。
【23199】Re:複数のファイルの作業
発言  かみちゃん  - 05/3/16(水) 6:35 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>この作業マクロを最初に指定したフォルダにある複数のファイルを指定して、同
>じ範囲のデータを抽出する作業をさせたいのですが、出来ますでしょうか？

まずは、以下の過去ログを参考にされてはいかがでしょうか？
特定フォルダ内のファイル名の一覧（サブフォルダ未対応）
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=21105;id=excel
ファイルを開かずにセルの値を取得
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=17856;id=excel
【23236】Re:複数のファイルの作業
質問  あいんすと  - 05/3/16(水) 23:24 -
引用なし
パスワード
   ▼かみちゃん さん：
ヒントありがとうございます。
参考に今日作ってみました。

開いているフォルダと同じファイル内にあるエクセルファイルを
リストボックスに表示させます。

Private Sub UserForm_Initialize()

'開いているファイルと同じフォルダ内にあるファイル名の取得
Dim xlname As Variant
xlname = Dir(ActiveWorkbook.Path & "\*.xls")

Do Until xlname = ""
　　ListBox1.AddItem = xlname
　　xlname = Dir
Loop

End Sub

同じ作業をするマクロを作ったのですが･･･、
いざやってみると、｢フォルダが読み取り専用です｣と
メッセージが出て止まってしまいました。
読み取り専用は別に関係ない筈なのですが、理由が分かりません。

ちなみに以下の通りです。

Private Sub CommandButton1_Click()

Dim open_file As Variant　　'開いているファイル
open_file = ActiveWorkbook.Name
xlname = Dir(ActiveWorkbook.Path & "\*.xls")

Do While ActiveWorkbook.Path & ListBox1.Value <> ""

'最初に開いているファイルはそのまま作業する
If ListBox1.Value = open_file Then　　
　　data_drain　 '作業マクロ
Else　　'同フォルダ内のエクセルファイル
　　Workbooks.Open ActiveWorkbook.Path & ListBox1
　　data_drain　 '作業マクロ
　　ActiveWorkbook.Close False '保存せずに閉じる
End If
　　xlname = Dir
Loop

Workbooks(open_file).Activate　　'最初に開いているファイルを表示
MsgBox "終了しました"
End Sub
【23241】Re:複数のファイルの作業
回答  かみちゃん  - 05/3/17(木) 6:49 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>開いているフォルダと同じファイル内にあるエクセルファイルを
>リストボックスに表示させます。

なぜ、リストボックスに表示させる必要があるのでしょうか？
以下は、リストボックスに表示させない方法です。
ただし、「最初に指定したフォルダにある複数のファイルを指定して、同じ範囲の
データ」を「どこに」抽出するのかが書かれていないので、下の例では、A2セルに
ばかり抽出するようにしています。これではまずいと思いますが・・・

Option Explicit
Sub Macro1()
　Dim xlname As String

　xlname = Dir(ActiveWorkbook.Path & "\*.xls")
　Do While xlname <> ""　　' ループを開始します。
　　'値を取得するファイル名を表示
　　MsgBox ActiveWorkbook.Path & "\" & xlname
　　
　　'ファイルを開かずにセルの値を取得
　　'抽出先のセルの指定（どこに抽出するのかわからない）
　　Range("A2").Select
　　With Selection
　　　.Formula = "='" & ActiveWorkbook.Path & "\[" & xlname & "]Sheet1'!A2"
　　　.Value = .Value
　　End With
　　
　　xlname = Dir
　Loop
End Sub

どうしても、リストボックスを使う必要があるのならば、

>　　Workbooks.Open ActiveWorkbook.Path & ListBox1

ListBox1の何番目のデータを処理しているのかが明示されていないからでは？
と思います。
【23242】Re:複数のファイルの作業
回答  かみちゃん  - 05/3/17(木) 7:08 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>いざやってみると、｢フォルダが読み取り専用です｣と
>メッセージが出て止まってしまいました。

メッセージが出た箇所はわかりますでしょうか？
　Workbooks.Open ActiveWorkbook.Path & ListBox1
で、出ると思いますが、これは、ListBox1だけでは何番目のデータかがわからないからです。
　MsgBox ListBox1
としてみてください。データが取得できていないことがわかると思います。

そこで・・・

>Do While ActiveWorkbook.Path & ListBox1.Value <> ""
>
>'最初に開いているファイルはそのまま作業する
>If ListBox1.Value = open_file Then　　
>　　data_drain　 '作業マクロ
>Else　　'同フォルダ内のエクセルファイル
>　　Workbooks.Open ActiveWorkbook.Path & ListBox1
>　　data_drain　 '作業マクロ
>　　ActiveWorkbook.Close False '保存せずに閉じる
>End If
>　　xlname = Dir
>Loop

を以下のようにしてみてください。
With ListBox1
　For i = 0 To .ListCount - 1
　　If .List(i) = open_file Then
　　　data_drain　 '作業マクロ
　　Else　　'同フォルダ内のエクセルファイル
　　　Workbooks.Open ActiveWorkbook.Path & "\" & .List(i)
　　　data_drain　 '作業マクロ
　　　ActiveWorkbook.Close False '保存せずに閉じる
　　End If
　Next
End With

data_drainがどういう処理をしているのかがわからないのですが、値を取得するだけだと、ファイルを開く必要はないと思います。
また、さきほども書きましたが、ListBoxをなぜ使わないといけないのかがわかりません。
【23254】フォルダの有無
質問  あいんすと  - 05/3/17(木) 13:08 -
引用なし
パスワード
   ▼かみちゃん さん：

早速の回答ありがとうございます。
更に質問です。デスクトップにフォルダを作成したいのですが、
同じフォルダ名があるとエラーが出るので、回避でif文を入れたのですが、
駄目でした。このif文は間違っているのでしょうか？

Sub make_folder()
Dim MyWSH As Object
Dim MyDesktopPath As String
Set MyWSH = CreateObject("WScript.Shell")
MyDesktopPath = MyWSH.SpecialFolders("Desktop")

If MyDesktopPath & "\DATA_DRAIN" = "" Then
　　ChDir MyDesktopPath
　　MkDir "DATA_DRAIN"
End If

End Sub
【23255】Re:フォルダの有無
回答  かみちゃん  - 05/3/17(木) 13:52 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>駄目でした。このif文は間違っているのでしょうか？

> If MyDesktopPath & "\DATA_DRAIN" = "" Then

MyDesktopPath & "\DATA_DRAIN"
という文字列と
""
という文字列をを比較していますから、絶対に一致することはありませんよね？

ちなみに、次のような感じでできると思います。
単なるフォルダの存在チェックしかしていませんが・・・

Sub make_folder()
　Dim MyWSH As Object
　Dim MyDesktopPath As String
　Set MyWSH = CreateObject("WScript.Shell")
　MyDesktopPath = MyWSH.SpecialFolders("Desktop")
　If Dir(MyDesktopPath & "\DATA_DRAIN", vbDirectory) = "" Then
　　MkDir MyDesktopPath & "\DATA_DRAIN"
　Else
　　MsgBox MyDesktopPath & "\DATA_DRAIN　はすでに存在します"
　End If
End Sub
【23273】Re:フォルダの有無
お礼  あいんすと  - 05/3/18(金) 0:12 -
引用なし
パスワード
   ▼かみちゃん さん：

返事が遅れましたが、回答ありがとうございます。

以下の方法では、何故かフォルダを作成出来ませんでした。
>>　　MkDir MyDesktopPath & "\DATA_DRAIN"

以下のように、一度カレントをデスクトップに移してから、
フォルダを作成する様にしなければいけませんでした。

ChDir MyDesktopPath
MkDir "DATA_DRAIN"
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
10178 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free