| 
    
     |  | セルを1つづつ読み書きする事が非常に遅いので、こんな事をすると少しは速く成ると思います 全データを配列に取得し、其れを使って確保した結果出力用配列に処理を書き込みます
 集計処理が終わったら結果用配列をシートに出力しています
 
 Option Explicit
 
 Sub ResetList2()
 
 Dim i As Long
 Dim lngRows As Long
 Dim rngList As Range
 Dim vntData As Variant
 Dim vntResult As Variant
 
 'データの先頭を基準とする
 Set rngList = Cells(1, 1)
 
 With rngList
 'データ行数を取得
 lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
 If lngRows <= 1 And .Value = "" Then
 Set rngList = Nothing
 Exit Sub
 End If
 'データを配列に取得
 vntData = .Offset(, 2).Resize(lngRows + 1).Value
 End With
 
 '出力用配列を確保
 ReDim vntResult(1 To lngRows, 1 To 4)
 
 'データ全行に就いて繰り返し
 For i = 1 To lngRows
 vntResult(i, 1) = Left(vntData(i, 1), 1)
 vntResult(i, 2) = Mid(vntData(i, 1), 2, 1)
 vntResult(i, 3) = Mid(vntData(i, 1), 3, 1)
 vntResult(i, 4) = Right(vntData(i, 1), 1)
 Next i
 
 '集計結果を出力
 rngList.Offset(, 3).Resize(lngRows, 4).Value = vntResult
 
 Set rngList = Nothing
 
 MsgBox "リストのリセットが完了しました!!"
 
 End Sub
 
 
 |  |