vba いろいろ

コード表示  alt + F11     ※開発モード前提です


特定なブックのシートの文字列を置換又は設定

Sub ƒ{ƒ^ƒ“1_Click()


'MsgBox ("start")

    Dim myPath As String, myBook As String
    Dim Ws As Worksheet

    'myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\24\"  'ŽŽŒ±—p
    
    'myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\24\"
    'myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\25\"
'    myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\26\"    '”­‘—‚̏ꍇ
'    myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\26\‹¤’ÊŠÇ—(ƒ}ƒCƒjƒ“ƒO)\"    'ƒ}ƒCƒjƒ“ƒO‚̏ꍇ
    myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\27\"
'    myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\271\"
    myBook = Dir(myPath & "*.xlsx")
    
    Dim n As Integer
    

    Do Until myBook = ""
        Workbooks.Open myPath & myBook
        
        scnt = Worksheets.Count
               
        n = 0
        
        For Each Ws In Worksheets
'        Ws.Select
        
        'MsgBox (Ws.Name)

        'Ws.Rows(1).Interior.Color = 5287936    'ƒZƒ‹—ΐF
        
        If Ws.Name = "•\Ž†" Then
            Ws.Range("O7") = "IE8–o–őΉž"
            Ws.Range("O11") = "IE8ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒhAIE11ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh‰æ–Ê•\Ž¦“®ìŠm”F"
            'Ws.Range("F19") = Replace(Worksheets(1).Range("F19"), "í”Ձ@–M•F", "ŠÖ@‰ª")
            Ws.Range("F19") = "ŠÖ@‰ª"
            Ws.Range("F20") = "2023/04/27"
            Ws.Range("O42") = "2023.04-WP301D‹@”\ƒOƒ‹[ƒv“àŒ‹‡ŽŽŒ±"
            Ws.Range("O43") = "2023.10-WP301D‹@”\ƒOƒ‹[ƒv“àŒ‹‡ŽŽŒ±"
            Ws.Range("F3") = "‹¤’ÊŠÇ—"    '‚»‚Ì‘¼ŠÇ—‚̏ꍇ,ƒ}ƒCƒjƒ“ƒO‚̏ꍇB
'            Ws.Range("F3") = "‹¤’Ê‹Æ–±"     '”­‘—‚̏ꍇ
            Ws.Range("C9") = "2023.10-WP301D‹@”\ƒOƒ‹[ƒv“àŒ‹‡ŽŽŒ±"
        'End If
        
        ElseIf Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡@" Then
'            Ws.Range("E3") = "IE8ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh"
'            Ws.Range("G3") = "IE11ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh"
'            Ws.Range("E24") = "¦IE8–o–ÅŠm”F‚Ì‚½‚ß‚Ì‹¾‚Æ‚µ‚ÄŠm”F"
        'End If
    
        ElseIf _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡A" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡B" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡C" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡D" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡E" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡F" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡G" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡H" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡I" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡J" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡K" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡L" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡M" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡N" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡O" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡P" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡Q" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡R" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡S" _
        Then
        
            Ws.Range("V7") = "IE8ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh"
            Ws.Range("X7") = "IE8ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh‚ÆIE11ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh‚Ì”äŠr"
            
        ElseIf Ws.Name = "javascript" Then
'        MsgBox ("V7")
            
        Else
        
        End If
        
        n = n + 1
        
        If n = scnt - 2 Then
'            Exit For
        End If
        
        
        Next
        
        Workbooks(myBook).Close SaveChanges:=True    '•Û‘¶‚µ‚ĕ‚¶‚é
        
        myBook = Dir
    Loop


'MsgBox ("end")

'MsgBox ("ˆ—‚ªŠ®—¹‚µ‚Ü‚µ‚½")


End Sub


特定な文字列を検索
Sub ƒ{ƒ^ƒ“2_Click()


    Dim myPath As String, myBook As String
    Dim Ws As Worksheet

    'myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\24\"  'ŽŽŒ±—p
    
    'myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\24\"
'    myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\25\"
    'myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\26\"    '”­‘—‚̏ꍇ
    'myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\26\‹¤’ÊŠÇ—(ƒ}ƒCƒjƒ“ƒO)\"    'ƒ}ƒCƒjƒ“ƒO‚̏ꍇ
    
    myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\kanŽ‘Þ\ƒeƒXƒgŽd—l‘ì¬\Žw“E‘Ήž\01.‚»‚Ì‘¼ŠÇ—\"
'    myPath = "C:\kanŽ‘Þ\ƒeƒXƒgŽd—l‘ì¬\Žw“E‘Ήž\03.”­‘—\01.‘S‰æ–Ê‘ÅŒ®\"
'    myPath = "C:\kanŽ‘Þ\ƒeƒXƒgŽd—l‘ì¬\Žw“E‘Ήž\test\"
'    myPath = "C:\Users\test05\Documents\‚¨Žx•¥P\run\ŽÀŽ{\26\‹¤’ÊŠÇ—(ƒ}ƒCƒjƒ“ƒO)\"
    
    myBook = Dir(myPath & "*.xlsx")
    
    Dim n As Integer
    j = 13
    

    Do Until myBook = ""
        Workbooks.Open myPath & myBook
        
        n = 0
        
        For Each Ws In Worksheets
'        Ws.Select

        
'        If Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡@" Or Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡A" Then
'        If Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡A" Then
        If _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡A" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡B" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡C" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡D" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡E" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡F" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡G" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡H" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡I" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡J" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡K" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡L" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡M" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡N" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡O" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡P" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡Q" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡R" Or _
        Ws.Name = "ƒŒƒCƒAƒEƒgŠm”FŠÏ“_‡S" _
        Then
        
        

'        Workbooks("1.xlsm").Worksheets("Sheet1").Cells(13, 2).Value = "IE8ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh‚ÆIE11ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh‚Ì”äŠr"

        
'            myCnt = WorksheetFunction.CountIf(Ws.UsedRange, "OK")
'            myCnt = WorksheetFunction.CountIf(Ws.UsedRange, "EDGE‚Ì”äŠr")
            
            If Ws.Range("X7") = "IE11‚ÆEDGE‚Ì”äŠr" Then
'                Ws.Range("X7") = "IE8ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh‚ÆIE11ƒhƒLƒ…ƒƒ“ƒgƒ‚[ƒh‚Ì”äŠr"
'                MsgBox ("NG")
'                Exit Do
                Workbooks("1.xlsm").Worksheets("Sheet1").Cells(j, 2).Value = myBook
                Workbooks("1.xlsm").Worksheets("Sheet1").Cells(j, 13).Value = Ws.Name
                j = j + 1
            End If
            
            
'            If myCnt > 0 Then
'                MsgBox (myCnt)
'                Exit Do
'            End If
            
'             myCnt = WorksheetFunction.CountIf(Ws.UsedRange, "NG")
'
'            If myCnt > 0 Then
'                MsgBox (myCnt)
'                Exit Do
'            End If
        
            
        Else
        
        End If
        
        n = n + 1
        
'        If n = 6 Then
'            Exit For
'        End If
        
        
        Next
        
        Workbooks(myBook).Close SaveChanges:=True    '•Û‘¶‚µ‚ĕ‚¶‚é
        
        myBook = Dir
    Loop


'MsgBox ("end")

'MsgBox ("ˆ—‚ªŠ®—¹‚µ‚Ü‚µ‚½")








End Sub




列数から列名へ変換
CHR(列数+64)
例
1列
CHR(1+64)
結果 A



シートの使用の最大行数、列数を取得
    MaxRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
    MaxColumn = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column

シールの計算式を変更する
=countif(v10:v17."")  ⇒ =countif(v10:v17."OK")

for n=1 to 50
    cname=getname(n)  '列数から列名へ変換、自定義関数。
    cval=Ws.Range(cname & 3).Formula
    if InStr(cval,"conutif") > 0 then
    pcnt=InStr(cval,"OK")
    if pcnt = 0 then
    Ws.Range(cname & 3).Fromala = "=countif(" & cname & "10:" & "17,""OK"")"
    end if
next