戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
特定の文字が含まれるシートを次々に処理

    [189581] 特定の文字が含まれるシートを次々に処理-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ ひまわり -(2019/06/16(11:02))
    □U R L/
      お世話になります。
      
      
      1.やりたいこと
        1)シート名の先頭文字に「第」が含まれているシートをcsvファイルに書き出ししたい。
        2)「第」の文字が無いデータシートも多数ある。非表示シートも同じく多数ある。
        3)「第」の含まれるシート名毎にInputBoxを表示して、保存名を任意に変えている。
        4)「第」の含まれるシートは最大20シートです。
      
      2.現象
        1)1つのシートのcsv書き出しはちゃんと処理しています。逆に1つのファイルしか保存されない。
        2)「第」文字が含まれるシート1枚のみを枚数分繰り返して書き出ししているようで、次々に処理されない。
          
      
      3.エクセルデータ参考
         a列    B列      C,D列空白        E列     F列  G列    H列 
         4		第3-11号				aaa	a	b	2.84
         4		第3-11号				bbb	cc	dd	2.39
         4		第3-11号				ccc			0.45
         4		第3-11号				ddd	ff		0.08
         4		第3-11号				hhh			1
         5		第3-12号				aaa	a	b	21.01
         5		第3-12号				bbb	cc	dd	18.03
         5		第3-12号				qqq			2.98
         5		第3-12号				ddd	ff		0.46
         5		第3-12号				vvv		ss	32
      
      4.下記の作成コードで「第」を含むシートが3枚あるとすると、1つのシートのみしかcsvファイルに書き出し
        していない。
          
          Sub data_csvfuriwake()
           Dim ws As Worksheet
      
             For Each ws In Worksheets
                 If ws.Name Like "第*" Then  'シート見出し名先頭に「第」の文字があれば
                     Call writeCSV      'シートをcsv形式で書き出し処理
                 End If
             Next ws
          End Sub
      
      
      5.InputBox参考 
      
        Dim f_name As String
      
          f_name = InputBox("csvファイル保存名を入力して下さい")
              bk_name = folderPath & "\" & "Z" & CDbl(f_name) 'ファイル名先頭に必ず"Z"をつける
      
      
      よろしくお願いします。
      
      OS Windows10 EXCEL 2016


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189582] Re[1]: 特定の文字が含まれるシートを次々に処理-

    記事引用/メール受信=OFF■

    □投稿者/ マナ -(2019/06/16(11:10))
    □U R L/

      >Call writeCSV

      Call writeCSV(ws)

      writeCSVのパラメータとして、対象シートを与えるように修正するとよいです。




    [189583] Re[1]: 特定の文字が含まれるシートを次々に処理-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2019/06/16(11:14))
    □U R L/
      writeCSVのコードを示してください。
      
      対象とするwsというワークシートを
      writeCSVに持ち込んでいないからじゃないですか?
      
      ・ワークシートを新規ブックにコピーして、
      ・そのブックをCSVとして保存する
      という流れになると思いますが。




    [189590] Re[2]: 特定の文字が含まれるシートを次々に処理-

    記事引用/メール受信=OFF■

    □投稿者/ ひまわり -(2019/06/16(14:10))
    □U R L/
      お世話になります。
      
      コードも添付しないですいません。
      
      マナさん
      > Call writeCSV(ws) でエラーとなりました。
      
      γさん
      コードを添付します。
      1.最初に保存先フォルダを選択します。
      2.次にcsvファイルを書き出します。
        csvファイルの保存は拡張子無しのダブルクォーテーション囲み、カンマ区切り(空白も同様)です。
      
      よろしくお願いします。
      
      Private folderPath As Variant
      Private myFolder As String
          
      Sub Hozon_Folder()
          Dim ws As Worksheet
          
          '保存先フォルダを選択する
          With Application.FileDialog(msoFileDialogFolderPicker)
              If .Show = 0 Then
                  Exit Sub
              End If
              folderPath = .SelectedItems(1)
          End With
      
          myFolder = folderPath
          
          '「第」を含むシート名を次々に書き出し
          For Each ws In Worksheets
              If ws.Name Like "第*" Then 'シート見出し名先頭に「第」の文字があれば
                  Call writeCSV 'シートをcsv形式で書き出し処理
              End If
          Next ws
      End Sub
      
      Private Sub writeCSV()
          Const cnsFILENAME = "\data.csv"
          Dim intFF As Integer            'FreeFile値
          Dim x(1 To 8) As Variant        '書き出すレコード内容
          Dim GYO As Long                 '収容するセルの行
          Dim MyRow As Long               'データが収容された最終行
          Dim COL As Long                 'カラム(Work)
          Dim bk_name As String
          Dim FileName_InFolder As String
          Dim buf As String
          
          '収容最終行
          MyRow = Cells(Rows.Count, "A").End(xlUp).row
      
          'FreeFile値の取得
          intFF = FreeFile
          '指定ファイルを開く
          Open folderPath & "\" & cnsFILENAME For Output As #intFF
          '1行目から開始
          GYO = 1
          '最終行まで繰り返す
          Do Until GYO > MyRow
              For COL = 1 To 8
                  x(COL) = Cells(GYO, COL).Value
              Next COL
              ' レコードを出力(ダブルクォーテーション囲み、カンマ区切り)
              Write #intFF, CStr(x(1)), CStr(x(2)), CStr(x(3)), CStr(x(4)), CStr(x(5)), CStr(x(6)), CStr(x(7)), CStr(x(8))
              ' 行を加算
              GYO = GYO + 1
          Loop
          
          Close #intFF '指定ファイルを閉じる
          buf = InputBox("保存No(半角数字)を入力して下さい")
          bk_name = folderPath & "\" & "Z" & CDbl(buf)
      
          'データを使用できる形式にする(ファイル名変更、拡張子無し)
          Name folderPath & "\" & "data.csv" As folderPath & "\" & "Z" & CDbl(buf)
      End Sub
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189591] Re[3]: 特定の文字が含まれるシートを次々に処理-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2019/06/16(14:44))
    □U R L/
      Private Sub writeCSV(ws as Worksheet)
          '-- (途中省略)----    
          '収容最終行
          MyRow = ws.Cells(Rows.Count, "A").End(xlUp).row
      
          '-- (途中省略)----    
      
          Do Until GYO > MyRow
              For COL = 1 To 8
                  x(COL) = ws.Cells(GYO, COL).Value
              Next COL
          '-- (以下省略)----    
      End Sub
      のようにシートを特定する形式のプロシージャにしてから、
      Call writeCSV(ws)
      として呼び出すのではないですか?
      
      wsを付けるところが漏れているかも知れないし、その他の
      箇所は見ていませんので、あしからず。
      そちらで確認してください。


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189593] Re[4]: 特定の文字が含まれるシートを次々に処理-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ ひまわり -(2019/06/16(15:36))
    □U R L/

      γさん 
      できました。
      ありがとうございました。

      マナさん
      >writeCSVのパラメータとして・・・
      指摘されたてたのに、理解できなくてすいません。
      γさんのコメントで理解できました。
      ありがとうございました。



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G