2021-05-26

セルの塗りつぶされた色のRGBを求める方法

備忘録

これ↓↓

Sub test_RGB()

    Dim myColor As Long
    Dim R, G, B
    
    myColor = Range("A1").Interior.Color
    
    R = myColor Mod 256
    G = Int(myColor / 256) Mod 256
    B = Int(myColor / 256 / 256)
    
    Debug.Print R, G, B

End Sub

微妙な色で塗りつぶされた色もこれで、RGBの数値を取ってこれます。
また、Interior.ColorIndexはエクセルのバージョンで挙動が異なるらしいです。
なのでRGB使いましょう！

備忘録でした。(^^)/~~~

2021-05-26

複数のSheetに一括で同じ値を代入する方法

備忘録

複数Sheetの同じセルに一括で値を代入する方法。

マニュアル操作では、Sheetを複数選択していれば同じセルに値が一気に代入するされます。これをVBAで記述すると以下のコードになります。

Sub Sheets_Select()
    
    Worksheets("Sheet7").Select
    Worksheets("Sheet4").Select False
    Worksheets("Sheet6").Select False
    
    Dim i
    For Each i In ActiveWindow.SelectedSheets
        i.Range("A1").Value = 67
        Debug.Print i.Name, i.Range("A1").Value
    Next
    
End Sub

処理結果↓↓
f:id:bimori466:20210526170810p:plain

一気にというところは怪しいですが、一応こうなりました。
備忘録でした。(^^)/~~~

2021-05-26

複数のSheetに一括で同じ値を代入する方法

備忘録

複数Sheetの同じセルに一括で値を代入する方法。

マニュアル操作では、Sheetを複数選択していれば同じセルに値が一気に代入するされます。これをVBAで記述すると以下のコードになります。

Sub Sheets_Select()
    
    Worksheets("Sheet7").Select
    Worksheets("Sheet4").Select False
    Worksheets("Sheet6").Select False
    
    Dim i
    For Each i In ActiveWindow.SelectedSheets
        i.Range("A1").Value = 67
        Debug.Print i.Name, i.Range("A1").Value
    Next
    
End Sub

処理結果↓↓
f:id:bimori466:20210526170810p:plain

一気にというところは怪しいですが、一応こうなりました。
備忘録でした。(^^)/~~~

2021-05-26

指定した文字数の後に空白を入れる。

備忘録

方法１

Sub stringTest()

    Dim myString As String * 18
    myString = "bimori"
    Debug.Print myString

End Sub

処理結果↓↓
f:id:bimori466:20210526140219p:plain

この場合、"bimori"以降18文字までは空白が入ります。
しかし、この方法では文字数が変わったときに対応できません。

方法２

Sub stringTest2()

    Dim myString As String
    myString = "bimori"
    myString = myString & Space(12)
    Debug.Print myString
    
End Sub

Space関数で、指定した数の空白を足します。

備忘録でした～。(^^)/~~~

2021-05-24

セル内に斜線が入っているか判定して処理する。

備忘録

f:id:bimori466:20210524125608p:plain

セル内に右下がり斜線が入っているか判定する処理。

セルの書式設定で斜めに斜線が入っている場合処理をする方法はないものか？と考えて、ググったらありました。
ここでは、セルA6に右斜め斜線（実線）が入っている場合に、赤でセルを塗りつぶす処理です。

Sub セルの斜線()

    If Range("A6").Borders(xlDiagonalDown).LineStyle = xlContinuous Then
       MsgBox "右斜め実線あり"
       Range("A6").Interior.Color = vbRed
    Else
       MsgBox "右斜め実線なし"
    End If


End Sub

処理結果

f:id:bimori466:20210524105927p:plain

赤色で塗りつぶされました。

こんな具合で、セルに罫線が引いてあるかで処理判定に使えます。

セル内に右上がり斜線が入っているか判定する処理。

Sub セルの斜線2()

    If Range("A6").Borders(xlDiagonalUp).LineStyle = xlContinuous Then
       MsgBox "右斜め実線あり"
       Range("A6").Interior.Color = vbRed
    Else
       MsgBox "右斜め実線なし"
    End If

End Sub

Borders(xlDiagonalDown)　→　Borders(xlDiagonalUp)に変更するだけです。

ではでは、この辺で(^^)/~~~

2021-05-18

自作関数　正規表現を使って文字列付き連番に＋１した値を取得する。続き。

自作関数

f:id:bimori466:20210516060845p:plain

自作関数で-、/、空白の文字列付き連番を作る。

前回の記事で「文字列＋数字」の文字列付き連番の取得方法について解説しました。
bimori466-1.hatenablog.com

今回は、「数字＋英数字＋数字」のような場合の文字列付き連番の取得方法について解説します。

目次
　１　閲覧対象者
　２　得られる効果
　３　文字列付き連番の解析
　４　コードの解説　
　５　自作関数、-、/、空白の文字列付き連番のコード　
　６　感想

１　閲覧対象者

文字列付き連番に＋１した値がほしいとお困りの方。

２　得られる効果

文字列付き連番に対して＋１した値を取得します。

（具体的データの例）
1AE-6-051/011277
1AO-6-033 004181
1AE-6-051/ 043090
1AP-5-160/010109
XPAS192-002584
XAPS055-033051
HAPS411-008042
1SA-6-037 /004943
UAPS028-032458
1AO-6-033 004185
2O-5-025/000440
1EA-6-051/ 043087
PDD-5-004/002984
1OA-5-432 002941

３　文字列付き連番の解析

前回のおさらいになりますが、2章に列挙した具体的なデータ例を分析すると末尾6桁が数字である」ということがわかります。
しかし、今回は「数字＋文字列＋数字」というパターンです。この場合前回作った正規表現のパターン「"(\D+)(\d+)"」ではうまく取れません。「1AE-6-051/011277」を例として、実際に実行してみると以下のような結果になります。

f:id:bimori466:20210518165840p:plain

結果として、AE-7が出力されました。当然ですね。文字列を頭から見て、数字以外の文字列は「AE-」、次にくる数字のみの文字列は「６」です。連番文字列が６なので＋１して「AE-7」となります。ではどうすればいいでしょうか？

結論、-、/、空白で区切ればいいのです。
例の「1AE-6-051/011277」で言うと、「1AE-6-051/」と「011277」に分ければよいのです。
ではどうするか、コード解説します。

４　コードの解説

Sub 正規表現2()

    '正規表現の遅延バインディング
    Dim reg As Object: Set reg = CreateObject("VBScript.RegExp")
    
    '正規表現にマッチした文字列を格納するObject
    Dim matchString As Object, subMatchString As Object
    
    Dim targetString As String
    Dim targetStringプラス1 As String
    Dim strS As String
    Dim strN As String
    Dim separationStr As String
    Dim serchSrting As String
    Dim targetLen
    Dim resurutInstr1, resurutInstr2, resurutInstr3, rr
    Dim serchInstr1, serchInstr2, serchInstr3
    
    targetString = "1AE-6-051/011277"
    
    reg.Pattern = "(\D+)(\d+)"
        
    Set matchString = reg.Execute(targetString)(0)
    Set subMatchString = matchString.submatches
    
    
    'Pattern = "(\D+)(\d+)"がOKの処理
    strS = subMatchString(0)
    strN = subMatchString(1)
    
    
    If targetString = subMatchString.Item(0) & subMatchString.Item(1) Then
        targetLen = Len(strN)
        
        '連番作成
        strN = CLng(strN) + 1
        targetStringプラス1 = strS & Format$(strN, String$(targetLen, "0"))
        Debug.Print targetStringプラス1
    
    Else
        If InStr(1, targetString, "/") > 0 Then
                        
            '/より左側の文字列を取得
            reg.Pattern = "([^/]+(?:/))"
            Set matchString = reg.Execute(targetString)(0)
            strS = matchString.Value
            
            '/より右側の文字列を取得（/）を含むので、再度"(\D+)(\d+)"で数値を求める。
            reg.Pattern = "([/](\d+))"
            Set matchString = reg.Execute(targetString)(0)
            strN = matchString.Value
            
            reg.Pattern = "(\D+)(\d+)"
            Set matchString = reg.Execute(strN)(0)
            Set subMatchString = matchString.submatches
            separationStr = subMatchString.Item(0)
            strN = subMatchString.Item(1)
            targetLen = Len(strN)
            
            
            '連番作成
            strN = CLng(strN) + 1
            targetStringプラス1 = strS & Format$(strN, String$(targetLen, "0"))
            Debug.Print targetStringプラス1
        End If
    End If
    
End Sub

１　　変数targetStringに「1AE-6-051/011277」を代入。
２　　正規表現パターン”(\D+)(\d+)”でオブジェクト変数matchStringに文字列を取得する。
３　　オブジェクト変数subMatchStringにオブジェクト変数matchStringのsubmatchesを代入する。
４　　変数strSにオブジェクト変数subMatchString(0)を代入する。
　　　変数strNにオブジェクト変数subMatchString(1)を代入する
５　　変数targetStringと変数strS＆変数strNを比較する。

　ここからが、「/」の場合の処理
６　　一致しない場合、正規表現パターン"([^/]+(?:/))"でオブジェクト変数matchStringに文字列を取得する（/より左側の文字列を取得）。変数strSに値を代入する。
７　　正規表現パターン "([/](\d+))"でオブジェクト変数matchStringに文字列を取得する（/より右側の文字列を取得）。変数strNに値を代入する。
　　　補足：
　　　　VBAの正規表現では「後読み」ができないので、正確には「/を含む右側の文字列」を取得します。そのため、オブジェクト変数matchStringに対して、正規表現パターン"(\D+)(\d+)"で文字列を取得します。すると、「/」と「数字」に分かれた文字列がオブジェクト変数subMatchStringに取得できます。
８　　オブジェクト変数subMatchString(1)の値を変数strNに代入する。
９　　変数strNを＋１する。
１０　変数targetStringプラス1に、変数strS＆変数strNを代入する。

１～１０の工程を踏みます。長ったらしいですがこれで、「数字＋文字列＋数字」の連番を取ることができます。

処理結果↓↓
f:id:bimori466:20210518214641p:plain

1AE-6-051/011277　→　1AE-6-051/011278、ちゃんと連番になっていますね！

５　自作関数、-、/、空白の文字列付き連番のコード

今までのことを少し応用すれば、-、/、空白の文字列付き連番のコードが作成できます！

コードは以下の通り↓↓

Function myRegMachineNoNext(targetString As String)

    '正規表現の遅延バインディング
    Static reg As Object: Set reg = CreateObject("VBScript.RegExp")
    
    '正規表現にマッチした文字列を格納するObject
    Dim matchString As Object, subMatchString As Object
    
    Dim strS As String
    Dim strN As String
    Dim separationStr As String
    Dim serchSrting As String
    Dim targetLen
    Dim resurutInstr1, resurutInstr2, resurutInstr3, rr
    Dim serchInstr1, serchInstr2, serchInstr3
    
    reg.Pattern = "(\D+)(\d+)"
    
    strS = "": strN = "": separationStr = ""
        
        Set matchString = reg.Execute(targetString)(0)
        Set subMatchString = matchString.submatches
        
        
        If targetString = subMatchString.Item(0) & subMatchString.Item(1) Then
            'Pattern = "(\D+)(\d+)"がOKの処理
            strS = subMatchString(0)
            strN = subMatchString(1)
            
            targetLen = Len(strN)
            
            '連番作成
            strN = CLng(strN) + 1
            myRegMachineNoNext = strS & Format$(strN, String$(targetLen, "0"))
            
        Else
            'Pattern = "(\D+)(\d+)"がNGの処理（/、-、△）の処理。
            '-、/、△（空白）でどれが一番後ろの文字にでてくるか調べる。
            resurutInstr1 = 0: resurutInstr2 = 0: resurutInstr3 = 0
            rr = 1
            Do
                serchInstr1 = InStr(rr, targetString, "/")
                If serchInstr1 = 0 Then Exit Do
                resurutInstr1 = serchInstr1
                If serchInstr1 <> 0 Then rr = serchInstr1 + 1
            Loop Until serchInstr1 = 0
            If IsEmpty(resurutInstr1) Then resurutInstr1 = 0
            
            rr = 1
            Do
                serchInstr2 = InStr(rr, targetString, "-")
                If serchInstr2 = 0 Then Exit Do
                resurutInstr2 = serchInstr2
                If serchInstr2 <> 0 Then rr = serchInstr2 + 1
            Loop Until serchInstr2 = 0
            If IsEmpty(resurutInstr2) Then resurutInstr2 = 0
            
            rr = 1
             Do
                serchInstr3 = InStr(rr, targetString, " ")
                If serchInstr3 = 0 Then Exit Do
                resurutInstr3 = serchInstr3
                If serchInstr3 <> 0 Then rr = serchInstr3 + 1
            Loop Until serchInstr3 = 0
            If IsEmpty(resurutInstr3) Then resurutInstr3 = 0
            
            
            'serchSrting判定(一番後ろに出てくる文字)
            If resurutInstr1 > resurutInstr2 Then
                If resurutInstr3 > resurutInstr1 Then
                    serchSrting = " "
                Else
                    serchSrting = "/"
                End If
                
            Else
                If resurutInstr3 > resurutInstr2 Then
                    serchSrting = " "
                Else
                    serchSrting = "-"
                End If
            End If
            
            
            Select Case serchSrting
            
                Case Is = "/"
                    
                    If InStr(1, targetString, "/") > 0 Then
                        
                        '/より左側の文字列を取得
                        reg.Pattern = "([^/]+(?:/))"
                        Set matchString = reg.Execute(targetString)(0)
                        strS = matchString.Value
                        
                        '/より右側の文字列を取得（/）を含むので、再度"(\D+)(\d+)"で数値を求める。
                        reg.Pattern = "([/](\d+))"
                        Set matchString = reg.Execute(targetString)(0)
                        strN = matchString.Value
                        
                        reg.Pattern = "(\D+)(\d+)"
                        Set matchString = reg.Execute(strN)(0)
                        Set subMatchString = matchString.submatches
                        separationStr = subMatchString.Item(0)
                        strN = subMatchString.Item(1)
                        targetLen = Len(strN)
                        
                        
                        '連番作成
                        strN = CLng(strN) + 1
                        myRegMachineNoNext = strS & Format$(strN, String$(targetLen, "0"))
                    End If
                    
                Case Is = " "
                
                    If InStr(1, targetString, " ") > 0 Then
                        '△より左側の文字列を取得
                        reg.Pattern = "([^\s]+(?:\s))"
                        Set matchString = reg.Execute(targetString)(0)
                        strS = matchString.Value
                        
                        '\sより右側の文字列を取得（\s）を含むので、再度"(\D+)(\d+)"で数値を求める。
                        reg.Pattern = "([\s](\d+))"
                        Set matchString = reg.Execute(targetString)(0)
                        strN = matchString.Value
                        
                        reg.Pattern = "(\D+)(\d+)"
                        Set matchString = reg.Execute(strN)(0)
                        Set subMatchString = matchString.submatches
                        separationStr = subMatchString.Item(0)
                        strN = subMatchString.Item(1)
                        targetLen = Len(strN)
                       
                        
                        '連番作成
                        strN = CLng(strN) + 1
                        myRegMachineNoNext = strS & Format$(strN, String$(targetLen, "0"))
                    End If
                    
                Case Is = "-"
                
                    If InStr(1, targetString, "-") > 0 Then
                        
                        '-より左側の文字列を取得
                        reg.Pattern = "([^-]+(?:-))"
                        Set matchString = reg.Execute(targetString)(0)
                        strS = matchString.Value
                        
                        '-より右側の文字列を取得（-）を含むので、再度"(\D+)(\d+)"で数値を求める。
                        reg.Pattern = "([-](\d+))"
                        Set matchString = reg.Execute(targetString)(0)
                        strN = matchString.Value
                        
                        reg.Pattern = "(\D+)(\d+)"
                        Set matchString = reg.Execute(strN)(0)
                        Set subMatchString = matchString.submatches
                        separationStr = subMatchString.Item(0)
                        strN = subMatchString.Item(1)
                        targetLen = Len(strN)
                        
                        
                        '連番作成
                        strN = CLng(strN) + 1
                        myRegMachineNoNext = strS & Format$(strN, String$(targetLen, "0"))
                    End If
                    
                    
            End Select
        End If

End Function

処理を加えた点としては、-（ハイフン）、/（スラッシュ）、” ”（半角空白）の３つの内で一番遅くでできた文字列を正規表現パターンとします。それくらいですね！

ワークシート上の実行結果↓↓

f:id:bimori466:20210518215443p:plain

文字列付き連番が取得できていますね！以上です。

６　感想

実はこの自作関数は完璧ではありません。そう、末尾に-（ハイフン）、/（スラッシュ）、空白がきたら処理できません。空白はRtrimで対応はできますが、完璧な文字列付き連番にするにはもう少し工夫が必要ですね。しかしながら、大方このパターンで私の業務は問題なかったです。

いかがだったでしょうか。正規表現というとLinux、PowerShellなどをイメージしますが、VBAでも割と使えるんですね。
ExcelＶＢＡ奥が深い。しかし、もっとスマートな書き方がある気はしています。

ではでは、この辺で(^^)/~~~

2021-05-16

自作関数　正規表現を使って文字列付き連番に＋１した値を取得する。

自作関数

f:id:bimori466:20210516060845p:plain

エクセルVBAで正規表現を活用

お仕事で「文字列付き連番」に遭遇しました。
文字列付き連番って、変数に入れて＋１するだけでは連番は取れないのです。
今回は、文字列＋数字、-（ハイフン）、/（スラッシュ）、” ”（半角空白）この4パターンの文字列付き連番に＋１した値を取得するFunctionを作成してみました。
正規表現をよくわかってませんが、なんとかなりましたｗ

目次
　１　閲覧対象者
　２　得られる効果
　３　文字列付き連番の解析
　４　VBAで正規表現を使う方法　
　５　「文字列＋数字」の場合の連番を取得する　
　６　感想

１　閲覧対象者

文字列付き連番に＋１した値がほしいとお困りの方。

２　得られる効果

文字列付き連番に対して＋１した値を取得します。

（具体的データの例）
ABB-F 074984
ASS-E-004348
AFJ-E/096888
1AE-6-051/011277
1AO-6-033 004181
1AE-6-051/ 043090
1AP-5-160/010109
XPAS192-002584
XAPS055-033051
HAPS411-008042
1SA-6-037 /004943
UAPS028-032458
1AO-6-033 004185
2O-5-025/000440
1EA-6-051/ 043087
PDD-5-004/002984
1OA-5-432 002941

３　文字列付き連番の解析

2章に列挙した具体的なデータ例を分析してみましょう。そうすると、どうやら「末尾6桁が数字である」ということがわかります。
ただし、「文字列＋数字」という単純な組み合わせだけでなく、「数字＋文字列＋数字」というパターンもあります。
では実際に、文字列付き連番を取得するコードを書いてみましょう！

４　VBAで正規表現を使う方法

遅延バインディングの例

　'正規表現の遅延バインディング
    Static reg As Object: Set reg = CreateObject("VBScript.RegExp")
    
    '正規表現にマッチした文字列を格納するObject
    Dim matchString As Object, subMatchString As Object

実行時バインディングの設定方法は、ここでは割愛します。
とりあえず、これで正規表現を使う準備は整いました。実際に正規表現を使ってみましょう！

５　「文字列＋数字」の場合の連番を取得する

「文字列＋数字」このパターンが一番多く、簡単だと思います。
具体的な例で言うと、
ABB-F 074984
ASS-E-004348
AFJ-E/096888

この３パターンです。この３つを例に正規表現の使い方を見てみましょう。

まずは「ABB-F 074984」のパターンを使って説明します。
変数targetStringに"ABB-F 074984"を直代入しています。
では、正規表現の使い方を説明します。

Sub 正規表現1()

    '正規表現の遅延バインディング
    Dim reg As Object: Set reg = CreateObject("VBScript.RegExp")
    
    '正規表現にマッチした文字列を格納するObject
    Dim matchString As Object, subMatchString As Object
    
    Dim targetString As String
    Dim targetStringプラス1 As String
    Dim strS As String
    Dim strN As String
    Dim separationStr As String
    Dim serchSrting As String
    Dim targetLen
    Dim resurutInstr1, resurutInstr2, resurutInstr3, rr
    Dim serchInstr1, serchInstr2, serchInstr3
    
    targetString = "ABB-F 074984"
    
    reg.Pattern = "(\D+)(\d+)"
        
    Set matchString = reg.Execute(targetString)(0)
    Set subMatchString = matchString.submatches
    
    'Pattern = "(\D+)(\d+)"がOKの処理
    strS = subMatchString(0)
    strN = subMatchString.Item(1)
    
    targetLen = Len(strN)
    
    '連番作成
    strN = CLng(strN) + 1
    targetStringプラス1 = strS & Format$(strN, String$(targetLen, "0"))
    Debug.Print targetStringプラス1
    
End Sub

コードの説明

１　正規表現の遅延バインディング
　　Dim reg As Object: Set reg = CreateObject("VBScript.RegExp")

２　正規表現のマッチングパターンを選択する。
　　reg.Pattern = "(\D+)(\d+)"

　　補足：
　　"(\D+)(\d+)"中の「\」は「￥」でも構いません。ここでは「\」で統一します。
　　「\D」とは、任意の数値以外の文字を取得します。
　　「\d」とは、任意の数値を取得します。
　　「(\D)」の「()」はパターンのグループ化です。私の理解では、subMatchesで使うためのものと理解しています。詳細は後ほど。

３　オブジェクト変数matchStringにreg.Patternで設定した正規表現の取得を実行する。
　　Set matchString = reg.Execute(targetString)(0)

４　オブジェクト変数matchStringのsubmatchesに格納された配列を、オブジェクト変数subMatchStringに格納する。
　　Set subMatchString = matchString.submatches

　　補足：
　　今回の文字列「ABB-F 074984」で数字以外の文字列（\D）は「ABB-F 」です。また、数字の文字列（\d）は「074984」です。
　　この二つが、オブジェクト変数matchString.submatchesに配列として格納されます。

５　変数strSにmatchString.submatches(0)を格納します（ABB-F ）。また、変数strNにmatchString.submatches(1)を格納します（074984）。

６　連番を取得するため、変数strNに＋１をします。
　　strN = CLng(strN) + 1
　　
　　補足：
　　変数strNには「074984」が文字列として格納されています。文字列の数字を結合すると先頭の「０」は無くなってしまします。そのため、Format関数を使っています。

Executeの挙動を確認する。

実際にExecuteしたときのデータの取れ方をウォッチウィンドウで確認してみましょう。
そうすると、以下の画像の通り↓↓
f:id:bimori466:20210516075308p:plain

matchStringのsubmatchesに、数値以外のデータと数値のデータが取得できていることがわかります。これがおそらくグループ化「（）でくくる」意味なのだと思います。
後は、変数strS、変数strNにmatchString.submatches(0)、matchString.submatches(1)の値を代入します。

＊注Item1となっていますが、初期値はsubmatches(0)です。

実行結果

「ABB-F 074984」の連番「ABB-F 074985」が取得できていますね！
f:id:bimori466:20210516075804p:plain

６　感想

多くの文字列付き連番は、「reg.Pattern = "(\D+)(\d+)"」この正規表現で解決するのではないかと思っております。
しかしながら、「数字＋文字列＋数字」この場合では機能しません。
記事が長くなったので、文字列＋数字、-（ハイフン）、/（スラッシュ）、” ”（半角空白）この３パターンの文字列付き連番の取得の仕方は後述します。

追加記事を書きました。↓↓
bimori466-1.hatenablog.com

ではでは、この辺で(^^)/~~~

これ↓↓

複数Sheetの同じセルに一括で値を代入する方法。

複数Sheetの同じセルに一括で値を代入する方法。

方法１

方法２

セル内に右下がり斜線が入っているか判定する処理。

処理結果

セル内に右上がり斜線が入っているか判定する処理。

自作関数で-、/、空白の文字列付き連番を作る。

１ 閲覧対象者

２ 得られる効果

３ 文字列付き連番の解析

４ コードの解説

５ 自作関数、-、/、空白の文字列付き連番のコード

ワークシート上の実行結果↓↓

６ 感想

エクセルVBAで正規表現を活用

１ 閲覧対象者

２ 得られる効果

３ 文字列付き連番の解析

４ VBAで正規表現を使う方法

５ 「文字列＋数字」の場合の連番を取得する

コードの説明

Executeの挙動を確認する。

実行結果

６ 感想

１　閲覧対象者

２　得られる効果

３　文字列付き連番の解析

４　コードの解説

５　自作関数、-、/、空白の文字列付き連番のコード

６　感想

１　閲覧対象者

２　得られる効果

３　文字列付き連番の解析

４　VBAで正規表現を使う方法

５　「文字列＋数字」の場合の連番を取得する

６　感想