戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
Excelファイルを指定行数分割&CSVファイル保存

    [195675] Excelファイルを指定行数分割&CSVファイル保存-

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

    □投稿者/ 串山 -(2023/04/02(18:42))
    □U R L/

      こんにちは。
      突然ですがお知恵をお貸しください


      以下のようなエクセルマクロは作成できますか?

      エクセルマクロは独学で行っており、様々な関連ホームページを見ても、

      自身で解決できず質問させてもらいました。

      よろしくお願いいたします。

      ・マクロと同フォルダにあるTEST.xlsxファイルのC列に”@”があればその行を削除
      ・D列にて頭文字がDUMMYで始まるデータがあれば、その行を削除
      ・C列に重複データがあれば、その行ごと削除
      ・C列をA列に移動
      ・A列以外を削除
      ・Excel_.xlsxとしてマクロ直下フォルダ"Example"に保存
      ・Excel_.xlsxにあるデータを180行ずつ分割し、それぞれcsvファイルととして保存
      ・そしてファイル保存名は4桁の連番を付与したい



      ++++++++++++++++++++
      OS      ⇒OTHER
      Version⇒OTHER
      ++++++++++++++++++++




    [195676] (削除)-

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

    □投稿者/ / -(2023/04/02(21:37))
    □U R L/

      この記事は削除されました




    [195677] Re[2]: (削除)-

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

    □投稿者/ FOL -(2023/04/02(22:04))
    □U R L/
      こんばんは。
      要望機能に対して、スクリプトを作りましたが、分からない部分を具体的に教えて頂ければ、こちらもアドバイスし易いのでお願いします。
      どれだけデータ量があるのかも分かりませんので、処理速度が遅いと感じましたら修正を加えてください。
      
      <1>特定データの削除
      
      Sub DeleteRows()
      
          ' 変数宣言
          Dim wb As Workbook       ' ブック
          Dim ws As Worksheet      ' シート
          Dim lastRow As Long      ' ワークシートの最終行
          Dim rng As Range         ' 範囲
      
          ' ファイルを開く
          Set wb = Workbooks.Open(ThisWorkbook.Path & "\TEST.xlsx")
          Set ws = wb.Sheets(1)
          lastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
      
          ' 列Cに"@"が含まれる行を削除
          Set rng = ws.Range("C1:C" & lastRow)
          rng.AutoFilter Field:=1, Criteria1:="=*@*", Operator:=xlAnd
          ws.Range("A1:D" & lastRow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
          rng.AutoFilter
      
          ' 列Dに"DUMMY"が含まれる行を削除
          Set rng = ws.Range("D1:D" & lastRow)
          rng.AutoFilter Field:=1, Criteria1:="=DUMMY*", Operator:=xlAnd
          ws.Range("A1:D" & lastRow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
          rng.AutoFilter
      
          ' 列Cで重複している行を削除
          Set rng = ws.Range("A1:D" & lastRow)
          rng.RemoveDuplicates Columns:=Array(3), Header:=xlYes
      
          ' C列をA列に移動
          ws.Range("C:C").Cut ws.Range("A:A")
      
          ' A列以外を削除
          ws.Range("B:XFD").Delete
      
          ' ファイルを保存
          wb.SaveAs ThisWorkbook.Path & "\Example\EXCEL_.xlsx", FileFormat:=xlOpenXMLWorkbook
          wb.Close SaveChanges:=False
      
          ' ファイルを閉じる
          Set wb = Nothing
      
      End Sub
      
      <2>Excelファイルのcsvファイルへの分割化
      
      Sub SplitData()
      
          ' 変数宣言
          Dim wb As Workbook      ' 現在のExcelファイル
          Dim ws As Worksheet     ' 現在のワークシート
          Dim lastRow As Long     ' ワークシートの最終行
          Dim i As Long           ' 行番号用のループカウンタ
          Dim j As Long           ' 列番号用のループカウンタ
          Dim fileNum As Integer  ' 出力ファイル番号
          Dim outputPath As String ' 出力ファイルのパス
          Dim csvFilename As String ' 出力ファイル名
      
          ' 現在のExcelファイルを設定
          Set wb = ThisWorkbook
      
          ' "\Example\EXCEL_.xlsx"を開く
          Set ws = Workbooks.Open(ThisWorkbook.Path & "\Example\EXCEL_.xlsx").Worksheets(1)
      
          ' ワークシートの最終行を取得
          lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
      
          ' 出力ファイルの初期値を設定
          fileNum = 1
          csvFilename = "output_" & Format(fileNum, "0000") & ".csv"
          outputPath = ThisWorkbook.Path & "\Example\" & csvFilename
      
          ' データを180行ずつ分割し、csvファイルとして保存
          For i = 1 To lastRow Step 180
              Open outputPath For Output As #1
              For j = i To i + 179
                  If j <= lastRow Then
                      Write #1, Join(Application.Transpose(ws.Rows(j).Value), ",")
                  End If
              Next j
              Close #1
      
              ' ファイル番号をインクリメント
              fileNum = fileNum + 1
      
              ' 出力ファイル名を更新
              csvFilename = "output_" & Format(fileNum, "0000") & ".csv"
              outputPath = ThisWorkbook.Path & "\Example\" & csvFilename
          Next i
      
          ' "\Example\EXCEL_.xlsx"を閉じる
          ws.Parent.Close False
      
      End Sub 


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

      <FONT COLOR='green'>緑の太文字→注釈
      <FONT COLOR='brown'>茶色の太文字→条件分岐
      <FONT COLOR='red'>赤の太文字→ループ
      <FONT COLOR='BLUE'>青の太文字→その他



      ++++++++++++++++++++
      OS      ⇒Macintosh
      Version⇒OTHER
      ++++++++++++++++++++


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

      <FONT COLOR='green'>緑の太文字→注釈
      <FONT COLOR='brown'>茶色の太文字→条件分岐
      <FONT COLOR='red'>赤の太文字→ループ
      <FONT COLOR='BLUE'>青の太文字→その他


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

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




    [195678] Re[3]: (削除)-

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

    □投稿者/ 串山 -(2023/04/03(22:10))
    □U R L/

      どうもありがとうございます!!

      1のスクリプトは上手く動きましたが、2の方は途中でエラーが出ました。
      下記の箇所ですが、自分なりに修正しても上手く行かずです。

      Write #1, Join(Application.Transpose(ws.Rows(j).Value), ",")

      無論、自分でも考えますが、何か対処方法はありますか?

      よろしくお願いします。





      ++++++++++++++++++++
      OS      ⇒OTHER
      Version⇒OTHER
      ++++++++++++++++++++




    [195682] Re[4]: (削除)-

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

    □投稿者/ 串山 -(2023/04/05(08:57))
    □U R L/

      2のスクリプトですが、マクロ以外の別の方法で対応することができました。
      お手間取らせてしまい、申し訳なかったです。
      どうもありがとうございます。


      ++++++++++++++++++++
      OS      ⇒OTHER
      Version⇒OTHER
      ++++++++++++++++++++



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

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

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


- Child Forum -
Edit:ゆう-G