簡略化と空白セルが詰められてしまう現象の修正方法を教えてください 複数のエクセルを集計するのに使用し

簡略化と空白セルが詰められてしまう現象の修正方法を教えてください
複数のエクセルを集計するのに使用しています
集計用のエクセルでワンプッシュで別フォルダから100件までのエクセルが読み取れるようになっています。コピペで作成しているため簡単にできないかと思い相談させていただきました。
また、データを読み込むと元のエクセルには空白セルがあるのですが取り組んだエクセルには空白セルが詰められてしまっています。この現象も対策できるのでしょうか？

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2008/11/12 ユーザー名 :
'
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\３Ｄ検査書\検査データ\a (1).csv", _
Destination:=Range("A1"))
.Name = "a (1)"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

a(2)~a(99)省略

ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\３Ｄ検査書\検査データ\a (100).csv", _
Destination:=Range("A1"))
.Name = "a (1)"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

No.1 回答者： ママチャリ 回答日時： 2018/08/05 15:55

100回繰り返している処理をサブプロシジャ化して、それを100回コールするようにします。

呼ぶ側は引数として１～１００の番号を呼ばれる側に渡します。呼ばれる側は、その番号を使って、入力ファイル名などを特定します。詳細は、添付画像を参照してください。赤文字の部分が主な修正ポイントです。
「空白セルが詰められてしまう」のは、.TextFileColumnDataTypes = Array(1) のせいだと思います。添付画像のように Array(1,1,2,1,・・・) のようにします。これが何を意味するかというと、セルの書式設定に相当し、１＝標準、２＝文字列を表します。要するに、空白が詰まってしまう列に対して、「2」を指定すれば良い（はず）です。この例では、3カラム目を文字として指定しています。
※添付のソースはテストを行っていません（文法チェックもしていない）ので、コーディングミスがあったらごめんなさい。

No.2 ベストアンサー 回答者： siffon9 回答日時： 2018/08/05 19:01

> コピペで作成しているため簡単にできないかと思い相談させていただきました。

これはNo.1さんの仰るとおりFor～Nextで繰り返し処理にします。

> また、データを読み込むと元のエクセルには空白セルがあるのですが
> 取り組んだエクセルには空白セルが詰められてしまっています。この現象も対策できるのでしょうか？

.TextFileConsecutiveDelimiter を Falseにしてください。


あと読み込むデータの詳細が不明でしたが、不要と思われる項目を削除しました。
もし動作がおかしい様でしたら項目を追加してみてください。


Sub Macro2()
　　Dim i As Long
　　Dim conn As String
　　
　　For i = 1 To 100
　　　　conn = "TEXT;C:\３Ｄ検査書\検査データ\a (" & i & ").csv"
　　　　' aと(の間にスペースがあるのは良いのか？

　　　　ActiveWorkbook.Worksheets.Add
　　　　With ActiveSheet.QueryTables.Add(Connection:=conn, Destination:=Range("A1"))
　　　　　　.TextFilePlatform = 932
　　　　　　.TextFileStartRow = 1
　　　　　　.TextFileParseType = xlDelimited
　　　　　　.TextFileConsecutiveDelimiter = False 'Trueから変更(空白セル詰め対応）
　　　　　　.TextFileCommaDelimiter = True
　　　　　　.TextFileTrailingMinusNumbers = True
　　　　　　.Refresh BackgroundQuery:=False
　　　　　　.Delete '追加
　　　　End With
　　Next
End Sub

この回答へのお礼

ありがとうございます！
データも軽くなりスムーズに動きました！
教えてくださってありがとうございました。

お礼日時：2018/08/06 12:20