Excel VBA質問箱 IV

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

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


22869 / 76732 ←次へ | 前へ→

【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

1 hits

【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 お礼

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