Excel VBA質問箱 IV

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

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


8373 / 13644 ツリー ←次へ | 前へ→

【33655】一覧表の作り方 初心者 06/1/17(火) 16:43 質問[未読]
【33660】Re:一覧表の作り方 じゅん 06/1/17(火) 19:28 回答[未読]
【33683】Re:一覧表の作り方 初心者 06/1/18(水) 10:47 回答[未読]
【33684】Re:一覧表の作り方 Jaka 06/1/18(水) 11:10 発言[未読]
【33706】Re:一覧表の作り方 初心者 06/1/18(水) 16:17 お礼[未読]
【33686】Re:一覧表の作り方 じゅん 06/1/18(水) 12:04 発言[未読]
【33690】Re:一覧表の作り方 じゅん 06/1/18(水) 13:21 回答[未読]
【33705】Re:一覧表の作り方 初心者 06/1/18(水) 16:16 お礼[未読]
【33662】Re:一覧表の作り方 Statis 06/1/17(火) 19:59 発言[未読]
【33682】Re:一覧表の作り方 初心者 06/1/18(水) 9:53 回答[未読]
【33689】Re:一覧表の作り方 Statis 06/1/18(水) 13:17 質問[未読]
【33691】Re:一覧表の作り方 初心者 06/1/18(水) 13:33 回答[未読]
【33692】Re:一覧表の作り方 Statis 06/1/18(水) 13:59 回答[未読]
【33704】Re:一覧表の作り方 初心者 06/1/18(水) 16:14 お礼[未読]

【33655】一覧表の作り方
質問  初心者  - 06/1/17(火) 16:43 -

引用なし
パスワード
   VBAは全くの初心者です。OSはWindowsXP、Excel2000を使用しています。
よろしくお願いいたします。

サーバーに受注票が(注文1件につき1sheet、各20sheetずつあるファイルが5つ)保管されています。
書式等はすべて同じで、それぞれA10:B12、B10:B12、C10:I12に受注番号などのデータが入力されています。
今回は、その受注番号などの一覧表を作成しようと思ってVBAに初挑戦することになりました。

全くのド素人のため、丁度「これは良いかもしれない!」と思う記述をネット内で見つけることができ、もしルール違反だったら申し訳ないのですが、使わせていただくことにしました。範囲名などを変えて実行してみたところ、もともと1sheetのみのファイルに対しての記述であったため、book内での繰り返し処理がなく、うまくいきません。
四苦八苦しながら、やっとFor Intcount To Thisworkbook sheet.count(?) というループ処理がシートの数だけループするということを知りました。
ただそのステートメントをどこに挿入すれば良いのかが、あれこれやってみたのですがどうしても分かりません。
どうか教えてください!!

Sub test02()
 'Microsoft Shell Controls And Automation に参照設定をしておくこと。
 Dim strPath      As String
 Dim objShell     As New Shell32.Shell
 Dim objFolder     As Shell32.Folder
 Dim strFileName    As String
 Dim lngRow      As Long
 Dim wbkSource     As Workbook
  
  'フォルダ選択ダイアログ
 Set objFolder = objShell.BrowseForFolder(0, "フォルダを選択してください。", 0)

  ' 選択内容を取得
 If Not objFolder Is Nothing Then
  strPath = objFolder.Items.Item.Path
  If Right(strPath, 1) <> "\" Then
   strPath = strPath & "\"
  End If
  
  strFileName = Dir(strPath & "*.xls", vbNormal)
  If strFileName <> "" Then
   Application.ScreenUpdating = False    '画面表示抑止
   With ThisWorkbook.ActiveSheet
   
    .Range("A1:C1").EntireColumn.ClearContents
    lngRow = 0
    
    Do While strFileName <> ""
     lngRow = lngRow + 1
     Set wbkSource = Workbooks.Open(strPath & strFileName)
     .Cells(lngRow, "A").Value = wbkSource.ActiveSheet.Range("A10:B12").Value
     .Cells(lngRow, "B").Value = wbkSource.ActiveSheet.Range("B10:B12").Value
     .Cells(lngRow, "C").Value = wbkSource.ActiveSheet.Range("C10:I12").Value
     wbkSource.Close False
     strFileName = Dir()
    Loop
   End With
   Application.ScreenUpdating = True    '画面表示抑止の解除
  End If
 End If
 Set objFolder = Nothing
 Set objShell = Nothing
End Sub

です。
出来れば、フォルダを選択せず、パス名を入れたいのですが出来ず、サーバー内のフォルダだからなのかそれも分からずじまいです。
・シートの数だけループする
・サーバー内のフォルダを指定する
方法を、教えてください。よろしくお願いいたします。

【33660】Re:一覧表の作り方
回答  じゅん  - 06/1/17(火) 19:28 -

引用なし
パスワード
   ▼初心者 さん:
とりあえず、主なご質問にだけ答えさせていただきます。
(的を外していたら、すみません)
>・シートの数だけループする
Public Sub subWorkSheetCount()
  Dim WS     As Worksheet
  Dim strMessage As String
  
  'シートの数だけメッセージボックスが表示されます
  For Each WS In Application.Worksheets
    MsgBox WS
  Next
  
End Sub

>・サーバー内のフォルダを指定する
以前、ご質問をさせていただき、ichinoseさまよりご回答を
いただきました内容がご参考になるかもしれません。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=30797;id=excel

【33662】Re:一覧表の作り方
発言  Statis  - 06/1/17(火) 19:59 -

引用なし
パスワード
   こんにちは

>.Cells(lngRow, "A").Value = wbkSource.ActiveSheet.Range"A10:B12").Value
>.Cells(lngRow, "B").Value = wbkSource.ActiveSheet.Range("B10:B12").Value
>.Cells(lngRow, "C").Value = wbkSource.ActiveSheet.Range("C10:I12").Value

データもとの範囲と入力する範囲が一致していないのでは?
一部データが重複しているようですが(B10:B12)

データ元のシートレイアウトとそれをどのように一覧にしたいのかを
記載して下さい。

【33682】Re:一覧表の作り方
回答  初心者  - 06/1/18(水) 9:53 -

引用なし
パスワード
   ▼Statis さん:
おはようございます。
早速ご回答頂き誠にありがとうございます。
データ元のシートレイアウトは
A10:A12に受注番号(元番)、B10:B12に受注番号(枝番)、C10:I12に受注件名です。
どのようにレイアウトしたいかというと、A列に元番、B列に枝番、C列に件名とシンプルにしたい。
出来ればそこから、該当するデータの存在するシートにジャンプできるように設定できるともっと効率よく仕事が出来るのですが・・・

よろしくお願いします。

【33683】Re:一覧表の作り方
回答  初心者  - 06/1/18(水) 10:47 -

引用なし
パスワード
   ▼じゅん さん:
早速ご回答頂きまして、誠に有り難うございます。
メッセージボックスの件ですが、今回の件とは別のようです。
ですが、ループに関して今後の参考とさせて頂きたいと存じます。
重ねて、誠に有り難うございました。

サーバー内のフォルダ指定の件ですが、この構文のどの部分を使えば良いのかが、分からない(T_T)
パス名がメッセージボックスで出るようになるのが分かりましたが、カレントディレクトリを変更し、移動先でデータを取得するとなると、どのようにすれば良いのでしょうか。
お手数おかけして申し訳ございませんが、今一度お教え願えますでしょうか?

【33684】Re:一覧表の作り方
発言  Jaka  - 06/1/18(水) 11:10 -

引用なし
パスワード
   >   Set wbkSource = Workbooks.Open(strPath & strFileName)
                          ↓間違い
>   .Cells(lngRow, "A").Value = wbkSource.ActiveSheet.Range("A10:B12").Value
                 ××ブックのアクティブシート?
                 別のブックが選択されていたらどうするのでしょうか?

   ブックを開くと必ずアクティブになるから、
   シート名が不明ならこれで良いです。  
   .Cells(lngRow, "A").Value = ActiveSheet.Range("A10:B12").Value


>  strFileName = Dir(strPath & "*.xls", vbNormal)
Dir関数で、ネットワーク上のフォルダを参照するのなら...。
[#33579]

【33686】Re:一覧表の作り方
発言  じゅん  - 06/1/18(水) 12:04 -

引用なし
パスワード
   ▼初心者 さん:
メッセージボックスは、「あのコードでシート名が取得出来ますよ」
ってことを目で見て確認してもらうために書いたので、
きちんと使用するにあたっては、メッセージボックスの箇所に
コードを書く必要がございます。
(例えば、シートをアクティブにして値を取得する等)

サーバー内のフォルダ指定の件は、
Sub test()
 Dim WshShell
 MsgBox CurDir
 Set WshShell = CreateObject("WScript.Shell")
 WshShell.CurrentDirectory = "\\mypc\d" '←UNCパス
 MsgBox CurDir
End Sub
こちらのコードは、試していただけたのですよね?

このコードで、カレントディレクトリが変更されますので、
後はフォルダ内のブックを指定し、さらにはシートを指定し・・・
ってことになるのでしょうかね?
なかなか時間が取れないため、文章のみでの回答になってしまいますこと、
すみません。。

【33689】Re:一覧表の作り方
質問  Statis  - 06/1/18(水) 13:17 -

引用なし
パスワード
   ▼初心者 さん:
>▼Statis さん:
>>A10:A12に受注番号(元番)、B10:B12に受注番号(枝番)、C10:I12に受注件名です。
>どのようにレイアウトしたいかというと、A列に元番、B列に枝番、C列に件名とシンプルにしたい

受注件名はどのように表示するのですか?

データ元シート
   A  B  C D E F J H I
1
2
.
.
10 A   1  a b c d e f g
11 B   2  h i j k l m n
12 C   3  o p q r s t u


転記先シート
 A  B  C
1 A  1   →C列にどのように転記するのですか?
2 B  2
3 C  3

【33690】Re:一覧表の作り方
回答  じゅん  - 06/1/18(水) 13:21 -

引用なし
パスワード
   ▼初心者 さん:

Public Sub subMacro()
  Dim WshShell As Object
  Dim strBookName As String
  Dim wsWorkSheet As Worksheet
  
  Set WshShell = CreateObject("WScript.Shell")
  WshShell.CurrentDirectory = "\\localPC"           '←UNCパス
  'MsgBox CurDir
  
  strBookName = Dir(CurDir & "\", vbNormal)
  While strBookName <> ""
    'MsgBox strBookName
    
    Workbooks.Open Filename:=CurDir & "\" & strBookName   '(カレントディレクト内の)ブックを開く
    For Each wsWorkSheet In Application.Worksheets
      MsgBox wsWorkSheet.Cells(1, 1).Value        '1行A列の値を取得
    Next
    
    ActiveWorkbook.Close                  '開いたブックを閉じる
    strBookName = Dir()
  Wend
End Sub

こんな感じでいかがでしょう?
(UNCパスで)指定したサーバ内のファイルを順番に開き、シート内のデータを取得します。

【33691】Re:一覧表の作り方
回答  初心者  - 06/1/18(水) 13:33 -

引用なし
パスワード
   ▼Statis さん:
申し訳ありません。こちらの勉強不足で、範囲を入力しなければならないのかと思ってA10:A12という形式にしていたのですが、実は、セルを結合しているだけなので、A10だけの表記で出来ますね。
ということで、C列ですが、文字列をそのまま転記ということでよろしくお願いいたします。

【33692】Re:一覧表の作り方
回答  Statis  - 06/1/18(水) 13:59 -

引用なし
パスワード
   こんにちは
A10:A12→結合
B10:B12→結合
C10:I12→結合
と考えて。

記載シートはA〜E列まで使います。
A〜C列は転記データ、D列にファイル名、E列にシート名を記載します。
E列のシート名にハイパーリンクを設定します。(該当シートが開きます)

Const strPath As String = "\\NetPc\C\Test\" '実際のパス名に変更
上記を実際のパス名に変更してお試しを。


Sub test03()


 Dim strFileName As String, Sh As Worksheet, wbkSource As Workbook


 Const strPath As String = "\\NetPc\C\Test\" '実際のパス名に変更

 strFileName = Dir(strPath, vbNormal)
 If strFileName = "" Then Exit Sub

 Application.ScreenUpdating = False
 With ThisWorkbook.ActiveSheet
    .Range("A1:E1").EntireColumn.Clear
    Do Until strFileName = ""
     Set wbkSource = Workbooks.Open(strPath & strFileName)
     For Each Sh In wbkSource.Worksheets
       With .Cells(.Rows.Count, 1).End(xlUp)
          .Offset(1, 3).Resize(, 2).Value = Array(strFileName, Sh.Name)
          ActiveSheet.Hyperlinks.Add Anchor:=.Offset(1, 4), Address:= _
              strPath & strFileName & "#" & Sh.Name & "!A1"
          .Offset(1).Value = Sh.Range("A10:A10").Cells(1).Value
          .Offset(1, 1).Value = Sh.Range("B10:B12").Cells(1).Value
          .Offset(1, 2).Value = Sh.Range("C10:I12").Cells(1).Value
       End With
     Next Sh
     wbkSource.Close False
     strFileName = Dir()
    Loop
 End With
 Application.ScreenUpdating = True


End Sub

【33704】Re:一覧表の作り方
お礼  初心者  - 06/1/18(水) 16:14 -

引用なし
パスワード
   ▼Statis さん:
出来ました!
ボタンを作成し、更新作業を出来るようにすることで、より使いやすくすることが出来ました。
鳥肌モノでした。
本当に有り難うございました!

【33705】Re:一覧表の作り方
お礼  初心者  - 06/1/18(水) 16:16 -

引用なし
パスワード
   ▼じゅん さん:
有り難うございました!解決しました。
御陰様でVBAの面白さを感じることが出来ました。
これからどんどん覚えていけるよう勉強します。
本当に有り難うございました。

【33706】Re:一覧表の作り方
お礼  初心者  - 06/1/18(水) 16:17 -

引用なし
パスワード
   ▼Jaka さん:
御陰様で解決しました、本当に有り難うございました!
色々なやり方があることを知りました。
これからどんどん勉強していこうと思います。
有り難うございました!

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