文字列を分割して1文字ずつセル入力するVBAのサンプルコード

VBA
記事内に広告が含まれています。

文字列を分割して1文字ずつセル入力する、VBAのサンプルコードを紹介します。

いわゆるExcel方眼紙で1文字1セル入力する形態をVBAコードでやろうというわけです。

仕様

試しに以下のようなExcelシートを用意して、1文字ずつセルに入力するVBAコードを作成します。

実行前

実行後(イメージ)

サンプルコードとテスト

大きく2種類のソースコードを作って実現してみました。

一般的な方法

一つ目はよく見かける一般的なソースコードです。

(細かいところは、人によって違ったりするのですが・・・)

入力テキストの1文字目からMid関数で1文字ずつ取得して、1文字ずつOffset関数でターゲットのセルに格納します。

コード(1レコード)

Sub splitText1record()
    
    '入力テキスト
    Dim intext As String
    intext = ActiveSheet.Cells(1, 1).Value
    
    '出力テキストのスタート位置
    Dim targetRange As Range
    Set targetRange = Range(Cells(1, 2).Address)
    
    Dim i As Long
    For i = 1 To Len(intext)
    
        'オフセットで1セルずつ右移動しながら、1文字ずつ格納
        targetRange.Offset(0, i - 1).Value = Mid(intext, i, 1)
    
    Next

End Sub
実行結果

結果、もちろん1文字ずつB列以降のセルに値が格納されています。

数か所程度の文字列をこの関数で1文字ずつ格納する分には、これで十分です。

コード(10000行)

ただこの方法で大量の入力を処理させると、どうなるでしょうか。

A列に10000行の値を用意して、10000行分実行してみました。

ソースコードは先ほどの方法を10000回繰り返すだけです。

あとは速度測定用のコードを追加しています。

Sub splitTextFullRecord()

    '開始時間取得
    startTime = Timer

    Dim i As Long
    For i = 1 To Cells(1, 1).End(xlDown).Row
        
        '入力テキスト
        Dim intext As String
        intext = ActiveSheet.Cells(i, 1).Value
        
        '出力テキストのスタート位置
        Dim targetRange As Range
        Set targetRange = Range(Cells(i, 2).Address)
        
        Dim j As Long
        For j = 1 To Len(intext)
        
            'オフセットで1セルずつ右移動しながら、1文字ずつ格納
            targetRange.Offset(0, j - 1).Value = Mid(intext, j, 1)
        
        Next
        
    Next
    
    '終了時間取得
    endTime = Timer
    
    '処理時間計算
    processTime = endTime - startTime
    MsgBox "処理時間:" & processTime
    
End Sub
実行結果

実行完了まで、11秒かかっています。

一見問題ないコードに見えますが、この方法では時間がかかるのです。

改善した方法

少し改善したコードを考えてみました。

最近は周知された方法のように思えるのですが、重たい処理部分を配列で扱えばよいです。

コード(10000行)

先ほどと同じようなシートを用意して、今度は配列を扱うコードで実行します。

可読性は少し落ちます。

Sub splitTextFullRecord2()
    
    '開始時間取得
    startTime = Timer
    
    '入力テキスト(A1~A1000) セル -> 配列格納
    ReDim intext(1, Cells(1, 1).End(xlDown).Row) As Variant
    intext = Range(Cells(1, 1), Cells(Cells(1, 1).End(xlDown).Row, 1)).Value
    
    '出力テキスト(2次元配列) ※100は決め打ち。
    Dim fieldNum As Integer
    fieldNum = 100
    ReDim outText(1 To Cells(1, 1).End(xlDown).Row, 1 To fieldNum) As String
    
    Dim i As Long
    For i = 1 To UBound(intext)
    
       'A列から値取得
        Dim record As String
        record = intext(i, 1)
        
        Dim j As Long
        For j = 1 To Len(record)
        
            '1文字ずつ格納
            outText(i, j) = Mid(record, j, 1)
        
        Next
        
    Next
    
    '配列 -> セル格納
    Range(Cells(1, 2), Cells(Cells(1, 1).End(xlDown).Row, fieldNum + 1)).Value = outText
    
    '終了時間取得
    endTime = Timer
    
    '処理時間計算
    processTime = endTime - startTime
    MsgBox "処理時間:" & processTime
    
End Sub
実行結果

実行時間は、なんと1.2秒です。

パフォーマンス測定結果

前後の処理時間は以下のとおりです。

大体9倍の速度アップです。

比較対象処理時間
改善前11.02734
改善後1.113281

「配列に格納して処理して、終わったら戻すだけでパフォーマンスが変わりますよ」という、まあありきたりな結論でした。

参考情報

環境

下記の環境で作成・実行しております。

No.環境バージョン
1OSWindows10
2ExcelExcel2016
環境一覧

以上です。