真・エクセルファイルの壊し方【VBAマクロ】

概要

以前エクセルファイルの壊し方について残したが、この度正しい(?)壊し方がわかったので共有。
VBAで256文字以上の入力規則は事実上作れないから注意しよう。

経緯

書いた本人が保守できなくなったからと、クソマクロの機能追加を依頼された。
影響する範囲に何故か毎回壊れるエクセルシートが含まれていたから、リファクタリングしながら原因の調査をついでに行った。
ほぼ別物になったけどどうせ開発者も保守できてなかったんだから問題ないな。

コード

百聞は一見にしかず、ということでコードをまずは見せる。
なお、１つ目のシート(Sheet1)のA1～A5(Cells(1,1)～Cells(5,1))に適当な文字を入力してある。(半角で合計16文字)

Const MaxRow = 30

' ファイルを壊す方法
Sub BreakSheet()
    Dim validationList As String
    Dim rowCount As Long
    Dim writeCount As Long

    validationList = ""

    For writeCount = 1 To MaxRow
        For rowCount = 1 To 5
            validationList = validationList & "," & Sheet1.Cells(rowCount, 1).Value
        Next rowCount

        ' データの入力規則の作成
        Sheet1.Cells(writeCount, 2).Validation.Delete
        Sheet1.Cells(writeCount, 2).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=validationList
    Next writeCount

End Sub

' 壊さない方法
Sub OnlyAddValidation_Cell()
    Dim writeCount As Long

    For writeCount = 1 To MaxRow
        ' データの入力規則の作成
        Sheet1.Cells(writeCount, 3).Validation.Delete
        Sheet1.Cells(writeCount, 3).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=GetValidationItemList()
    Next writeCount

End Sub

' 壊さない方法を改良
Sub OnlyAddValidation_Area()
    With Sheet1.Range(Sheet1.Cells(1, 3), Sheet1.Cells(MaxRow, 3)).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=GetValidationItemList()
    End With
End Sub

Function GetValidationItemList() As String
    Dim validationList As String
    Dim rowCount As Long

    validationList = ""

    For rowCount = 1 To 5
        validationList = validationList & "," & Sheet1.Cells(rowCount, 1).Value
    Next rowCount

    GetValidationItemList = Right(validationList, Len(validationList) - 1)

End Function

こう抜き出せば一発でわかるが、高度に難読化された上にどこに原因があるかわかっていない状態だったから最初に見ていたときには気がつけなかった。
この壊す方法の方のマクロを実行してから開いた時、「～～の一部の内容に問題が見つかりました。」のダイアログが表示された。

これでよし解決、とできれば話は早いのだが、実はまだいくつか謎が残っている。MaxRowを10に設定するとマクロが壊れないのだ。
その検証まで行ってから完了としよう。

追加検証

境界の探索

上記コードのMaxRowをいくつにしたら破損するかをしらべたところ、13以上で破損することがわかった。破損する方のコードでは、1回のループごとに16+5で21文字増えるので、13をかけると263文字。
この時点で答えは出ているような気もするが、念の為コードを書いて検証する。

境界の特定

下記のようなスクリプトを作り、文字数(CreateListの引数)を255と256で実行したエクセルファイルを作成し、開き直した。

' 確認用。
Sub TestValidation()
    With Sheet1.Cells(1, 4).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=CreateList(256)
    End With
End Sub

Function CreateList(length As Long) As String
    Const unit = "123456789,"
    ' Const unit = "１２３４５６７８９,"
    Const unitLength = 10
    Dim lestLength As Long

    lestLength = length
    CreateList = ""

    Do While lestLength > 0
        If lestLength >= unitLength Then
            CreateList = CreateList & unit
            lestLength = lestLength - unitLength
        Else
            CreateList = CreateList & Left(unit, lestLength)
            lestLength = 0
        End If
    Loop

End Function


Function CreateMultiByteList(length As Long) As String
    Const unit = "１２３４_,"
    Const singleByteUnit = "1234567890"
    Const unitLength = 10
    Dim lestLength As Long

    lestLength = length
    CreateMultiByteList = ""

    Do While lestLength > 0
        If lestLength > unitLength Then
            CreateMultiByteList = CreateMultiByteList & unit
            lestLength = lestLength - unitLength
        Else
            CreateMultiByteList = CreateMultiByteList & Left(singleByteUnit, lestLength)
            lestLength = 0
        End If
    Loop

End Function

すると、予想通り255では壊れずに256で壊れる結果となった。

興味深いのは、CreateMultiByteList(全角文字で256バイト分の文字列)を文字列生成に使ったら破損せず、
CreateListのコメントアウトしている部分を使っても255で壊れず、256で壊れる結果となったことだった。

文字のサイズによらず、256文字以上を受け取らないようだ。

結論

今回は入力規則だったが、256文字規制はここ以外にもありそうなので、
エクセルのプロパティに256文字以上の長文を指定するのは回避したほうが良いと思う。