Excel VBA質問箱 IV

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

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


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

【59214】データの整形 08/12/2(火) 16:12 質問[未読]
【59217】Re:データの整形 にぃ 08/12/2(火) 16:50 発言[未読]
【59219】Re:データの整形 08/12/2(火) 17:11 発言[未読]
【59220】Re:データの整形 にぃ 08/12/2(火) 17:43 発言[未読]
【59221】Re:データの整形 08/12/2(火) 18:04 発言[未読]
【59238】Re:データの整形 にぃ 08/12/3(水) 9:18 発言[未読]
【59240】Re:データの整形 08/12/3(水) 9:57 お礼[未読]

【59214】データの整形
質問    - 08/12/2(火) 16:12 -

引用なし
パスワード
   はじめまして。
いい知恵があればお貸し願えますでしょうか。

あるドライブのフォルダ構成を抽出するVBA(外部batファイルを利用)を組みました。
これにより、VBAを実行した時点で、

「A列にファイルの入っているフォルダ名」
「B列にファイル名」が入るようになっています。

例)
A列     B列
Aフォルダ  1.txt
Aフォルダ  2.txt
Bフォルダ  3.txt
Bフォルダ  4.txt
Bフォルダ  5.txt

ここからテキスト形式か、それに準じる形で

フォルダ名
 Aフォルダ
ファイル名
 1.txt
 2.txt

フォルダ名
 Bフォルダ
ファイル名
 3.txt
 4.txt
 5.txt

このような形に整形したいのです。
※フォルダ・ファイル名は固定ではありません。ファイル数も毎回変わります。

このような方法があるんじゃないか、というアイディアだけでも助かります。
どうぞよろしくお願いいたします。

【59217】Re:データの整形
発言  にぃ  - 08/12/2(火) 16:50 -

引用なし
パスワード
   ▼桜 さん:
こんにちは!

>例)
>A列     B列
>Aフォルダ  1.txt
>Aフォルダ  2.txt
>Bフォルダ  3.txt
>Bフォルダ  4.txt
>Bフォルダ  5.txt
>
>ここからテキスト形式か、それに準じる形で
>
>フォルダ名
> Aフォルダ
>ファイル名
> 1.txt
> 2.txt
>
>フォルダ名
> Bフォルダ
>ファイル名
> 3.txt
> 4.txt
> 5.txt
>

同じフォルダ名の時にファイル名を一まとめにしたいという
感じでしょうか。

こちらのサイトが参考になりますでしょうか?
ht tp://www.red.oit-net.jp/tatsuya/vb/Dictionary.htm

既に知っていたら重複してしまいますが、
キーを使用しA列のフォルダ名を取得して利用してみは
どうでしょう?

【59219】Re:データの整形
発言    - 08/12/2(火) 17:11 -

引用なし
パスワード
   こんにちは。アドバイスをありがとございます。

>同じフォルダ名の時にファイル名を一まとめにしたいという
>感じでしょうか。

その通りです。

毎度構成の違うフォルダ構成をメールで提出するというような作業がありまして、
様式が決まっているため、最終的には構成を自動で取り出し(ここまでは前述の通り、batと組み合わせて実現しております)
フォーマットに当てはめた形のデータをボタンひとつで実行できるようにしたいと思っています。

[フォルダ名]
  ●●
[ファイル名]
  ●●フォルダに入っているファイル(複数)

これをフォルダ数分繰り返すフォーマットになります。

>こちらのサイトが参考になりますでしょうか?
>ht tp://www.red.oit-net.jp/tatsuya/vb/Dictionary.htm
>
>既に知っていたら重複してしまいますが、
>キーを使用しA列のフォルダ名を取得して利用してみは
>どうでしょう?

拝見してみました。
まだVBA初心者のためちゃんと理解できているかは怪しいのですが、
キーを使用してA列のフォルダ名取得ができそうなのはわかりました。
取得したフォルダ名を持っている行のB列を抽出するようにすればいいのかな…と思うのですが、
それをフォーマット状に流し込むにはどうしたらいいのかがピンときません。
勉強不足でお恥ずかしいのですが、もう少しヒントをいただければ助かります。

お答えいただいてありがとうございました!

【59220】Re:データの整形
発言  にぃ  - 08/12/2(火) 17:43 -

引用なし
パスワード
   ▼桜 さん:
こんにちは!

>キーを使用してA列のフォルダ名取得ができそうなのはわかりました。
>取得したフォルダ名を持っている行のB列を抽出するようにすればいいのかな…と思うのですが、
A列のフォルダ名をキーに取得し、その同じ行のB列のファイル名をアイテムに
取得します。
「Scripting.Dictionary」には重複したキーを取得できないので
A列でキーが重複した場合、その時のアイテムにB列のファイル名を追加していく。
これの繰り返し作業をしてみてはどうでしょう?と思いました^^

>それをフォーマット状に流し込むにはどうしたらいいのかがピンときません。
ちょっと詳しくフォーマット?の状況がわかってないのであれなのですが、
既に[フォルダ名]等記載されているということでしょうか?

【59221】Re:データの整形
発言    - 08/12/2(火) 18:04 -

引用なし
パスワード
   早いレスポンスをありがとうございます!

>A列のフォルダ名をキーに取得し、その同じ行のB列のファイル名をアイテムに
>取得します。
>「Scripting.Dictionary」には重複したキーを取得できないので
>A列でキーが重複した場合、その時のアイテムにB列のファイル名を追加していく。
>これの繰り返し作業をしてみてはどうでしょう?と思いました^^

なるほど。
ちょっとこちらについては、流用可能なのか、じっくり調べながら中身を理解したいと思います。
いかんせん初心者なもので、少し時間をくださいませ…
ヒントをありがとうございます。

>ちょっと詳しくフォーマット?の状況がわかってないのであれなのですが、
>既に[フォルダ名]等記載されているということでしょうか?

ボタンひとつで、該当ドライブのフォルダ構成をもってきて、データが整形された形でメールが立ち上がるところまでやりたいと思っています。
セルやテキストファイルの値がメッセージに入ったメールを立ち上げるという部分はできているのですが、
肝心のデータが整形された形のセル(若しくはテキストファイル)を作ることができないでいます。

Sub メール報告()

Dim Subj As String
Dim BodyText As String

mlto = Cells(2, 1)
Subj = Cells(1, 2)
BodyText = Cells(3, 1) & Cells(4, 1)
t = "C:\Program Files\Outlook Express\msimn.exe /mailurl:mailto:" + mlto + "?subject=" & Subj & "&body=" & BodyText & "%20"
Shell t

End Sub


このBodyText部分に整形された形(フォルダごとにファイル名がまとまった状態)のセルを用意したいわけです。
分かるでしょうか…説明が拙くて申し訳ありません。

【59238】Re:データの整形
発言  にぃ  - 08/12/3(水) 9:18 -

引用なし
パスワード
   ▼桜 さん:
おはようございます!
遅くなってすみません。

えっと、簡単に考えると
>フォルダ名
> Aフォルダ
>ファイル名
> 1.txt
> 2.txt
↑のようなものをフォルダ名ごとに作り、
それをメールの本文にいれ一つ一つ送信したいという
感じなのでしょうか?

とりあえず最初の目的だけと考えまして。
下のサンプルコードを考えてみましたが参考になりますでしょうか。
こちらは、sheet1からsheet2に1行空白を入れ記述していく仕様です。
この[フォルダ名]と[ファイル名]をメール本文に入れていけばいけますか?

Sub test0()

  Dim Dic As Object
  Dim Keys As Variant
  Dim i As Long
  Dim j As Long
  Dim buf1 As String
  Dim buf2 As String
  Dim buf3 As String
  Dim RowCnt As Long
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  
  Set Dic = CreateObject("Scripting.Dictionary")
  Set ws1 = ThisWorkbook.Worksheets("sheet1")
  Set ws2 = ThisWorkbook.Worksheets("sheet2")
  
  RowCnt = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
  For i = 1 To RowCnt
  
    buf1 = ws1.Cells(i, 1).Value
    buf2 = ws1.Cells(i, 2).Value
    
    If Not Dic.Exists(buf1) Then 'キーが被らなかったら
      Dic.Add buf1, buf2
    Else             'キーが被ったら
      buf3 = Dic.Item(buf1) & Chr(10) & buf2 'アイテムに追加
      Dic.Item(buf1) = buf3 'アイテム書き換え
    End If
    
  Next
  
  Keys = Dic.Keys
  j = 0
  'sheet2へ記入
  For i = 0 To Dic.Count - 1
    ws2.Cells(j + 2, 1).Value = Keys(i)      'フォルダ名記入
    ws2.Cells(j + 3, 1).Value = Dic.Item(Keys(i)) 'ファイル名記入
    j = j + 3
  Next

End Sub

【59240】Re:データの整形
お礼    - 08/12/3(水) 9:57 -

引用なし
パスワード
   ありがとうございます!
実行してみたら一歩理想に近づくことができました。
まだどうしてこうなるかを理解していないので、
勉強し、理解した上で次のステップに進みたいと思います。
その際にまた助力を頂きに伺うことがあるかもしれませんが…。

本当にありがとうございました。

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