ここに質問の内容を詳しく書いてください。
ExcelVBAで複数のcsvファイルを読み込んでシートに貼り付けて、特定の列について集計するツールを作っています。
csvの貼り付けはネットで検索したものでうまくいきました。
現在、csvファイルの名前を取得してシートに記録して、そのセルの文字列をもとに貼り付けたcsvのシートをアクティブにして最終行にnullのセルをCOUNTBLANKで数えることを目的としています。csvの行数は10万行としました。
発生している問題・エラーメッセージ
問題点1
csvファイルの名前を取得してシートに記録するプログラムがうまく動きません。エラーメッセージはでないのですが、シートに記録されていません。
問題点2
最終行にCOUNTBLANKの集計結果がうまく記入されません。
エラーメッセージ
### 該当のソースコード Sub test1() '読み込むcsvファイル名を格納する変数 Dim bf As String Dim cnt As Integer Const Path As String = "ThisWorkbook\" 'csv 読み込みのための変数 Dim varFileName As Variant Dim FileName As Variant Dim CSVWorkSheet As Worksheet Dim NewWorkSheet As Worksheet Dim SheetName As String ' コピー範囲 Dim R1 As Integer Dim R2 As Long Dim C1 As Integer Dim C2 As Integer 'csvファイル名取得 bf = Dir(Path & "*.csv") Do While bf <> "" cnt = cnt + 1 Worksheets("Sheet2").Cells(cnt, 1).Value = bf bf = Dir() Loop ChDrive ThisWorkbook.Path varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択", MultiSelect:=True) If IsArray(varFileName) = False Then Exit Sub End If For Each FileName In varFileName SheetName = Dir(FileName) Set NewWorkSheet = CreateWorkSheet(SheetName) 'CSVファイルを開く Workbooks.Open FileName:=FileName Set CSVWorkSheet = ActiveSheet 'セル範囲取得 R1 = CSVWorkSheet.UsedRange.Row C1 = CSVWorkSheet.UsedRange.Column R2 = CSVWorkSheet.UsedRange.End(xlDown).Row C2 = CSVWorkSheet.UsedRange.End(xlToRight).Column 'セルの範囲のコピー CSVWorkSheet.UsedRange.Copy Destination:=NewWorkSheet.Range(NewWorkSheet.Cells(R1, C1), NewWorkSheet.Cells(R2, C2)) ActiveWorkbook.Close SaveChanges:=False 'nullチェック ActiveWorkbook.activeworksheet.Range("A100002").Value = WorksheetFunction.CountBlank(Range("A1:A100000")) End Sub Function CreateWorkSheet(WorkSheetName As String) As Worksheet Dim NewWorkSheet As Worksheet Dim ws As Worksheet Dim CheckSameName As Integer Set NewWorkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count)) CheckSameName = 0 For Each ws In Sheets If ws.Name = WorkSheetName Then MsgBox "WorkSheetName:" + WorkSheetName + " Used Name" CheckSameName = 1 End If Next If CheckSameName = 0 Then NewWorkSheet.Name = WorkSheetName Set CreateWorkSheet = NewWorkSheet End If End Function
試したこと
・ファイルのパスをマクロと同じ場所にあるようにするために
Const Path As String = "ThisWorkbook"
としました
'nullチェックを以下のように、開いているファイルをActiveWorkbook.activeworksheet.としました。
ActiveWorkbook.activeworksheet.Range("A100002").Value = WorksheetFunction.CountBlank(Range("A1:A100000"))
補足情報(FW/ツールのバージョンなど)
Excel2010
OS:windows7 x64
回答2件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2019/03/29 01:04