2022-08-27

【VBA】入力された大文字を小文字に変換する_LCase

所定のフォルダに格納された任意のファイル形式のファイル数を数える処理を作りたく調べていたら見つけたVBA関数：LCase。備忘のために記載します。

使い方

LCase（変数）

これで、（）内に入れた変数について、大文字⇒小文字に変換できる。

これを使い、A10セルに入力された値文字列について、大文字があれば小文字にしてA11セルにコピーするマクロを書いてみた↓

Sub TestLCase2()
Dim cell As Range
Dim ws As Worksheet

Set ws = ActiveSheet
Set cell = ws.Cells(10, 1)
ws.Cells(11, 1).Value = LCase(cell)
MsgBox "処理終了"

End Sub

実行前

実行後

2022-08-22

【VBA】マクロが置かれているディレクトリにある全xlsxファイルの全シートを取得する

前回は任意のシート名のシートのみ取得してきたが、今回は全シート無条件取ってきたい。

完成コードは以下。

Sub SheetCopyVer6()
Dim macroWb As Workbook

Dim importWb As Workbook
Dim importPath As String
Dim SheetName As String
Dim buf As String
Dim objSheet As Worksheet


Set macroWb = ThisWorkbook
'SheetName = Range("A2").Value


importPath = ThisWorkbook.Path

buf = Dir(importPath & "\" & "*.xlsx")

Do
If buf = "" Then Exit Do
MsgBox buf
Set importWb = Workbooks.Open(importPath & "\" & buf)
For Each objSheet In importWb.Worksheets
SheetName = objSheet.Name
importWb.Worksheets(SheetName).Copy After:=macroWb.Worksheets("Sheet0")
Next
importWb.Close
buf = Dir()

Loop

End Sub

これは比較的つまずかず、構文エラーのみで求める挙動になった。

ポイントは、インポートファイルをセットしたあと、For Each‥‥シート名の数だけ処理を回させるところと、シート名の取得方法。

どちらもググればすぐ出てきて簡単だった。

備忘録

2022-08-21

【VBA】マクロファイルが置かれているディレクトリにある全xlsxファイルから、任意のシートをコピーしたい

とりあえず動くものを作る VBA

■作る機能

このマクロファイルが置かれているディレクトリに置かれているファイル（この膜rファイル自身は含まない）から、指定のシート名のシートをコピーしてくる。

■作るための方法

ループの方法

特定のフォルダにあるファイル数分処理をしたいので、ループ処理が必要。VBAのループはわからないので調べてみたところ、以下４つくらい方法がありそう。

使い分けとしては、すごく端折ると、簡単なループはシンプルにForで良いらしい（それかDo Loop）。今回のように、フォルダ内のファイル分だけ処理を繰り返すものは、Do While。ただそれも、Do Loopでも実装は可能ということ。

ちなみに最初、Do Whileでやってみたが、ファイル名がnullのファイルを開こうとしてしまうエラー（後述）にぶち当たったので、Do Loopに変更。Do　Whileはまだ早かったようだ・・ほかにもやりたいことがあるので、一旦Do Loopで実装が出来れば今回はよしとした。

Do While
Do Until
Do Loop
For

■完成コード

Sub SheetCopyVer4()
Dim macroWb As Workbook

Dim importWb As Workbook
Dim importPath As String
Dim SheetName As String
Dim buf As String


Set macroWb = ThisWorkbook
SheetName = Range("A2").Value


importPath = ThisWorkbook.Path
buf = Dir(importPath & "\*")

Do
If ThisWorkbook.Name <> buf Then
End If
buf = Dir()
If buf = "" Then Exit Do
MsgBox buf
Set importWb = Workbooks.Open(importPath & "\" & buf)
importWb.Worksheets(SheetName).Copy After:=macroWb.Worksheets("Sheet0")
importWb.Close
Loop
End Sub

■つまずいた箇所

ファイル名　=　””の時は処理を抜けるように書いたつもりなのに抜けられておらず、ファイル名が””のファイルを開こうとして落ちてしまう。

■原因

Exitの位置。

正：

Do
If buf = "" Then Exit Do
MsgBox buf
Set importWb = Workbooks.Open(importPath & "\" & buf)
importWb.Worksheets(SheetName).Copy After:=macroWb.Worksheets("Sheet0")
importWb.Close

　　　 buf = Dir()

Loop
End Sub

誤：これだと、ファイル名（bufが空白の場合も、Workbooks.Open処理を走らせてしまいエラーになる）

Do
MsgBox buf
Set importWb = Workbooks.Open(importPath & "\" & buf)
importWb.Worksheets(SheetName).Copy After:=macroWb.Worksheets("Sheet0")
importWb.Close
　　　buf = Dir()

　　 If buf = "" Then Exit Do
Loop
End Sub

品質保証は未実施・・バグはあるかもだが、力尽きたので今日はここまで。