[[20230125162525]] 『特定の名前の含まれるシートのみ処理を行いたい』(アマツカゼ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『特定の名前の含まれるシートのみ処理を行いたい』(アマツカゼ)

当方VBA初心者です。お力添えいただけませんでしょうか。

EXCELのシートとシートを比較し、相違があれば赤字にするというVBAがあるのですが、特定の名前が含まれているシートすべてに処理を行いたいと考えています。
どのような処理を足したらよいか、どのように対応したらよいかわからず、こちらに相談させていただきました。

・C2セルに比較したいExcelファイルが格納されているフォルダのファイルパスが記載されています

・C3セルには、比較するために利用するCSVの格納されているフォルダのファイルパスが記載されています。

・B9:B60には、C2のセルに書かれているExcelファイル名が記載されています
(これは別のマクロで記載をおこなっています。)

行いたいことは、このB列に記載されているExcelを開くと、シートが複数入っており、『チェック』という名前の含まれたシートのU列のみ処理を行うという風にしたいと考えております。

しかし、シート名は『チェック』『チェック(1)』『チェック(2)』と複数あります

・・・・・下記記載されているVBA・・・・・・・・

Sub checkName()

    Apprlication.ScreenUpdating = False

    If MsgBox("チェックをおこないますか?", vbYesNo) Then
        Exit Sub
    End If

    Dim TargetBook As Workbook
    Dim CsvBook As Workbook
    Dim Path, CSVFileP As String
    Dim TargetSheetNames() As String

    'C2セルに、中身を確認したいファイルのファイルパスを記載しています
    'C3セルに、C2セルの中身をチェックするためのCSVファイルが入っています
    Path = Range("C2").Value
    CSVFileP = Range("C3").Value
    Dim buf As String

    'ファイルリスト(VBAの入っている当EXCELファイル)のB9:B60には、C2のファイルパスの中に入っているファイルのファイル名が記載されています

    'ファイルリストの最終行を取得
    Dim FLLastRowNo
    FLLastRowNo = Cells(Rows.Count, 2).End(xlUp).Row

    Dim FileList
    FileList = Range("B9:C" & FLLastRowNo).Value

    For i = LBound(FileList, 1) To UBound(FileList, 1)
        Dim newFileName As String
        newFileName = FileList(i, 1)

    'ここでは省略しますが以下の処理が記載されています
    '?@CSVFilePを開く処理→?A比較元になるA列の値を取得→?BCSVファイルを閉じる

    'ファイルリスト(VBAの入っている当EXCELファイル)のB9:B60が記載されており、それを開く処理だと思います↓

    If Dir(Path & newFileName) <> "" Then
        Workbooks.Open Path & newFileName
        Set TargetBook = Workbooks(newFileName)

    Else
        MsgBox "ファイルがありません" & Filename, vbExclamation
        Exit Sub
    End If

        For Each objWorksheet In TargetBook.Worksheets
        If objWorksheet.Name - strseetName Then
            blnFileExists = True
            Exit For
        End If
        Next

    '↓↑このあたりに、シート名に関する処理を入れたいです

        TargetSheetNames = getsheetName(TargetBook)

     'ファイルリスト(VBAの入っている当EXCELファイル)のB9:B60が記載されており、それを開いた後、最終行を取得
        Dim newLastRowNo
        newLastRowNo = TargetBook.Sheets(TargetSheetName).Cells(Rows.Count, 4).End(xlUp).Row

        'U列を確認したいので、U列を取得
        Dim CheckIchranList As Variant
        CheckIchranList = Range("U6:U" & newLastRowNo).Value

        '省略しますが、U列を一行ずつチェックし、比較。CSVFilePのA列の値と比較し、相違があれば赤字にする処理が記載されています

    Nexti

    MsgBox "チェックが完了しました"
    Application.ScreenUpdating = True

End Sub

< 使用 Excel:Microsoft365、使用 OS:Windows10 >


 回答ではないですが・・・。
 最初から躓いてますけど・・・。
    ↓
 Apprlication.ScreenUpdating = False

(名無し) 2023/01/25(水) 16:59:20


>>名無しさん

すみません、コードを書いたのは自分ではないので、そのあたりは詳しくわかっておらず、、
入力ミスなどもあるかもしれませんが、そのあたりは目をつぶっていただけますと幸いです><

下記の処理等、どこかで使えないかなと思ったのですが、どうやって使ったらいいか全然わからず。
お力添えいただけませんでしょうか

sub getSubSheetName()

    const Find_str ="チェック"
    Dim sh As Object
    For Each sh In Sheets
       If sh.Name Like Find_str & "*" Then
         sh.Select
         MsgBox sh.Name
       End If
     Next sh
End sub
(アマツカゼ) 2023/01/25(水) 17:17:30

>コードを書いたのは自分ではないので
そういうことでしたら、まずは【ステップ実行】してコードの検索をしてみては如何でしょうか。

>どうやって使ったらいいか全然わからず。
上記同様、何を処理する命令なのか研究してみましょう。
オマケですこし整理してみました。
(スマホで手打ち&未テストなのでミスっていたらごめんなさい)

 sub getSubSheetName_整理()
    Dim sh As Object
    For Each sh In Sheets
       If sh.Name Like "チェック*" Then
         MsgBox sh.Name & "シートのシート名は、" & vblf & "「チェック」と前方一致しています"
       End If
    Next sh
 End sub

(もこな2) 2023/01/25(水) 20:22:31


 Sub checkName()
    Const FIND_STR As String = "チェック"

    If MsgBox("チェックをおこないますか?", vbYesNo) = vbNo Then
        Exit Sub
    End If

    'C2セルに、中身を確認したいファイルのフォルダパスを記載しています
    'C3セルに、チェック用CSVファイルのファイルパスを記載しています
    Dim TargetFilePath As String
    TargetFilePath = Range("C2").Value
    Dim CSVFileP As String
    CSVFileP = Range("C3").Value

    '?@CSVFilePを開く処理→?A比較元になるA列の値を取得→?BCSVファイルを閉じる

    'ファイルリスト(VBAの入っている当EXCELファイル)のB9:B60に
    'C2のフォルダパスの中に入っているファイルのファイル名を記載しています
    Dim FileList As Variant
    FileList = Range("B9:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value

    Dim i As Long
    For i = LBound(FileList, 1) To UBound(FileList, 1)

        If Dir(TargetFilePath & FileList(i, 1)) <> "" Then

            Dim TargetBook As Workbook
            Set TargetBook = Workbooks.Open(TargetFilePath & FileList(i, 1))

            Dim sh As Object
            For Each sh In TargetBook.Worksheets
                If sh.Name Like FIND_STR & "*" Then
                    Application.ScreenUpdating = False

                    'objWorksheetのU列とCSVFilePのA列の値を比較し、相違があれば赤字にする

                    Application.ScreenUpdating = True
                End If
            Next
            TargetBook.Close 'SaveChanges:=True
        Else
            MsgBox "ファイルがありません" & FileList(i, 1), vbExclamation
        End If
    Next i
    MsgBox "チェックが完了しました"

 End Sub
(こんな感じかな) 2023/01/26(木) 10:34:27

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.