スキルアップ・問題解決なら、モーグにおまかせ！

B4:J9の範囲に１つのセルに１つの数字が入ります
  
3 B C D E F G H I J
  -+-+-+-+-+-+-+-+-+
4| | | | | |2|8|0|2|
  -+-+-+-+-+-+-+-+-+
5| | | | | |1|2|8|1|
  -+-+-+-+-+-+-+-+-+
6| | | | | |1|4|7|3|
  -+-+-+-+-+-+-+-+-+
7| | | | | | |2|4|5|
  -+-+-+-+-+-+-+-+-+
8| | | | | | |5|5|6|
  -+-+-+-+-+-+-+-+-+
9| | | | | |6|3|5|7|
  -+-+-+-+-+-+-+-+-+
  
B9:J9は4行目から8行目の各行を足した計算結果が入ります
  
下記test02では
TempData0211にB4:J8の範囲を格納して
各行の値を後に計算する必要から数値にして連結して
数値m0211に足していき
9桁のTempData0212に格納し
それから１文字ずつ9行目に書き込むということをしているのですが
とても遅いです
  
TempData0212を配列でB9:J9に書き込めれば改善されるのかもしれませんが
その方法がわかりません
  
改善策をお願いしたいです
よろしくお願いいたします
  
  
  
Sub test02()
      
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Dim TempData0211 As Variant
    Dim TempData0212 As Variant
    Dim leng0211 As Long
    Dim m0211 As Long
    Dim s0211 As Long
    Dim i0211 As Long
      
    TempData0211 = Range("B4:J9").Value
   
    For i0211 = LBound(TempData0211) To UBound(TempData0211)
        m0211 = m0211 + (CLng(TempData0211(i0211, 1)) & CLng(TempData0211(i0211, 2)) & CLng(TempData0211(i0211, 3)) & CLng(TempData0211(i0211, 4)) _
            & CLng(TempData0211(i0211, 5)) & CLng(TempData0211(i0211, 6)) & CLng(TempData0211(i0211, 7)) & CLng(TempData0211(i0211, 8)) & CLng(TempData0211(i0211, 9)))
        Debug.Print m0211
    Next i0211
   
    Debug.Print "m0211は、" & CStr(m0211)
      
    TempData0212 = Format(CStr(m0211), "@@@@@@@@@")
  
    Debug.Print "TempData0212は、" & TempData0212
      
    leng0211 = Len(TempData0212)
    Debug.Print "leng0211は、" & leng0211
      
    For s0211 = 0 To leng0211
        Cells(10, s0211 + 2) = Mid(TempData0212, s0211 + 1, 1)
    Next s0211
     
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
      
End Sub

その範囲の処理なら一瞬で終わるはずなので、
実際のセル範囲はもっと大きいということでしょうか。
 
(1)セル範囲を配列に読み込む
↓
(2)配列から1行ずつ数値に変換して加算していく
↓
(3)結果を１セルずつ書き込んでいく
 
という処理をしてますが、(1)(2)は配列処理なので十分高速なはずです。
 
(3)は1セルずつの処理なので遅いですが、9セルの処理なので遅いと体感できるはずがないです。
配列処理に書き換えれば高速化しますが、ミリ秒単位以下のレベルでしょう。
 
実際どのくらいの時間がかかっているのでしょうか。
 
 

これは何のための作業なんでしょうか。実用性は無いようにおもいますが。
なにかの練習問題ですか？
 
色々な書き方がありえると思います。一例です。

Sub test()
    Dim rng    As Range
    Dim rngNum As Range
    Dim k      As Long
    Dim s      As String
    Dim total  As Long
    Dim stotal As String
    Dim res    As Long

    '合計数値の計算
    Set rng = [G4].CurrentRegion '最初の行の最高位セル
    For k = 1 To rng.Rows.Count
        s = Join(Application.Index(rng.Rows.Item(k).Value, 0#), "")
        total = total + CLng(s)
    Next

    '書き込み先（1の位）
    Set rngNum = rng(rng.Count).Offset(1)
    '下の位から書き込む
    Do While total > 0
        res = total Mod 10
        rngNum = res
        Set rngNum = rngNum.Offset(0, -1)
        total = (total - res) / 10
    Loop
End Sub

ＶＢＡではなく、関数による代案を紹介します。
  
作業セルとして、列Ｌを使います。
  
Ｌ４に、
=CONCAT(B4:J4)*1
を入力し、下へフィルドラッグします。
Ｌ１０に
=SUM(L4:L9)
  
Ｂ１０に
=IF(SUM($A$10:A10)+MID(RIGHT(REPT("0",9)&$L$10,9),COLUMN(A1),1)=0,"",MID(RIGHT(REPT("0",9)&$L$10,9),COLUMN(A1),1)*1)
右へＪ１０セルまでフィルドラッグします。
 

たしかに「とても遅いです」というのはどうなのかと思いました。
 
コードの修正です。
・未使用変数 stotalが残ってしまいました。
・Set rng = [G4].CurrentRegion は
  Set rng = [J4].CurrentRegion　でないとまずいですね、考え方として。

私に環境では、次ンコードがエラーになりますが、

引用:

        m0211 = m0211 + (CLng(TempData0211(i0211, 1)) & CLng(TempData0211(i0211, 2)) & CLng(TempData0211(i0211, 3)) & CLng(TempData0211(i0211, 4)) _
            & CLng(TempData0211(i0211, 5)) & CLng(TempData0211(i0211, 6)) & CLng(TempData0211(i0211, 7)) & CLng(TempData0211(i0211, 8)) & CLng(TempData0211(i0211, 9)))

どこが遅いのか、範囲次第とは思います。
 
合計を出す所までの案を、2案ほど。
 
 
文字列として接続し、数値へ変換という意味では、simpleさんの案と同じですね。
Sub test03()
  Dim TempData As Variant
  Dim Ans As Long
  Dim i As Long
  Dim j As Long
  Dim strValue As String
 
  Dim sTime As Long
  Dim eTime As Long
 
  sTime = Timer
  TempData = Range("B4:J8").Value
  For i = LBound(TempData, 1) To UBound(TempData, 1)
    strValue = ""
    For j = LBound(TempData, 2) To UBound(TempData, 2)
      strValue = strValue & CStr(TempData(i, j))
    Next
    Ans = Ans + Val(strValue)
  Next i
  eTime = Timer
 
  Debug.Print "Test03 Ansは、" & CStr(Ans) & " 処理時間は " & eTime - sTime & "m秒"
 
End Sub
 
 
 
以下は、桁の重みを使って、各セルの値を合計してしまう方法。
Sub test04()
  Dim TempData As Variant
  Dim Ans As Long
  Dim i As Long
  Dim j As Long
 
  Dim sTime As Long
  Dim eTime As Long
 
  sTime = Timer
  TempData = Range("B4:J8").Value
  For i = LBound(TempData, 1) To UBound(TempData, 1)
    For j = UBound(TempData, 2) To LBound(TempData, 2) Step -1
      Ans = Ans + 10 ^ (UBound(TempData, 2) - j) * TempData(i, j)
    Next
  Next i
  eTime = Timer
 
  Debug.Print "Tsst04 Ansは、" & CStr(Ans) & " 処理時間は " & eTime - sTime & "m秒"
 
End Sub
 
 
B4:J9 程度では 処理速度としては、0ミリ秒でしょうけど。。

皆さんありがとうございます
 
遅さは9行目の数字（例では6357）が
一気に入力されず6→3→5→7と
１文字ずつの入力されるのが見える感じでしょうか
 
すいません
明日、職場の環境で検証させていただきます

参考コード

Option Explicit

Sub test()
Dim gokei
Dim Rx As Long
Dim Bunkai, KETA As Long
Dim myTime As Single

    myTime = Timer
    gokei = 0
    With ActiveSheet
        For Rx = 4 To 9
            gokei = gokei + WorksheetFunction.Concat(.Range(.Cells(Rx, "B"), .Cells(Rx, "J")))
        Next
        KETA = Len(gokei)
        gokei = CStr(Right(String(9, "0") & gokei, 9))
        
        ReDim Bunkai(1 To Len(gokei))
        For Rx = Len(gokei) To 1 Step -1
            If Rx < KETA Then
                Bunkai(Rx) = ""
            Else
                Bunkai(Rx) = Mid(gokei, Rx, 1)
            End If
        Next
        .Range("B10").Resize(1, 9).Value = Bunkai
        
    End With
               
Debug.Print Timer - myTime
            
    
End Sub
処理時間 0秒

blue_cars さんの引用:

遅さは9行目の数字（例では6357）が
一気に入力されず6→3→5→7と
１文字ずつの入力されるのが見える感じでしょうか

   Application.ScreenUpdating = False

参考コードのみそ
 
(1)B4〜J９の数値化：CONCAT関数で文字列結合⇒数値化⇒合計
(2合計値：前からゼロ埋めして９桁編集
(3)後ろ方１桁づつ配列に格納、（有効桁より前は０を""）
(4)配列からセル（B10:J10)に一括代入
※一般的に、ループ処理でセルに代入するのは、処理時間が掛かる。
※配列（１行ならば、１次元可）から一挙に代入する手法を使いましょう。、

皆さんありがとうございます
 
simpleさんのtestでは
 メッセージボックス「型が一致しません」vbExclamation + vbOKOnly + vbMsgBoxHelpButton
が表示され何も書き込まれません
 
Suzuさんのtest03では
 イミディエイトウィンドウに「Test03 Ansは、5801 処理時間は 0m秒」
が表示され何も書き込まれません
 
Suzuさんのtest04では
 イミディエイトウィンドウに「Tsst04 Ansは、5801 処理時間は 0m秒」
が表示され何も書き込まれません
 
WinArrowさんの関数代案は作業列が使えないです
 
WinArrowさんのtestでは
 メッセージボックス「400」vbCritical + vbOKOnly + vbMsgBoxHelpButtonのダイアログが表示され
何も書き込まれません
 
hatenaさん
> Application.ScreenUpdating = False
> と画面更新を停止しているのでそうなるはずがない。
確かに、検証したときはこのコード入れていなかったかも
今は一度に表示されますが2〜3秒かかって「6357」が表示されます

blue_cars さんの引用:

WinArrowさんのtestでは
 メッセージボックス「400」vbCritical + vbOKOnly + vbMsgBoxHelpButtonのダイアログが表示され
何も書き込まれません

Excelのバージョンを
Excel2019
を選択していますが、
個人のPCと職場のPCで同じ2019ですか？

WinArrowさん
ステップ実行でF8押していくと
> gokei = gokei + WorksheetFunction.Concat(.Range(.Cells(Rx, "B"), .Cells(Rx, "J")))
 
のところで[× 400]のメッセージボックスが出ます
 
職場のExcelですが
Microsoft® Excel® 2016 MSO (バージョン 2402 ビルド 16.0.17328.20124) 32 ビット
です

引用:
遅さは9行目の数字（例では6357）が
一気に入力されず6→3→5→7と
１文字ずつの入力されるのが見える感じでしょうか

引用:
For s0211 = 0 To leng0211
    Cells(10, s0211 + 2) = Mid(TempData0212, s0211 + 1, 1)
Next s0211

引用:
今は一度に表示されますが2〜3秒かかって「6357」が表示されます

引用:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

引用:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Excelのバージョン情報、ありがとうございました。
職場のPCにインストールされているExcel2016のバージョンでは、
CONCAT関数がサポートされていません。
 
コード修正
 
> gokei = gokei + WorksheetFunction.Concat(.Range(.Cells(Rx, "B"), .Cells(Rx, "J")))
を
            gokei = gokei + myCONCAT(.Cells(RX, "B").Resize(, 9).Value)
 
に変更してください
 
現在の
End Sub
の次の行に

Function myCONCAT(ByVal DATA)
Dim i As Long
    myCONCAT = ""
    For i = LBound(DATA, 2) To UBound(DATA, 2)
        If DATA(1, i) <> "" Then
            myCONCAT = myCONCAT & DATA(1, i)
        End If
    Next
End Function

引用:

[× 400]のメッセージボックスが出ます

skさん
イベント処理はまだ一つも入れていません
これがうまく動くようならchangeイベントでと考えておりましたので...
Application.EnableEvents = False
省略
Application.EnableEvents = False
は入れました
実行速度は変わりません
 
WinArrowさん
Excelのバージョン普段意識していなくて
職場が2016なんて古くてconcat使えないなんて考えてませんでした
掲示いただいたmyCONCATを入れてステップ実行したところ
 
gokei = gokei + myCONCAT(.Cells(RX, "B").Resize(, 9).Value)
 
で「型が違います」のエラーメッセージが出ます

WinArrowさん
一部訂正します
誤：「型が違います」のエラーメッセージが出ます
正：「型が一致しません」のエラーメッセージが出ます

エラーになるとの報告を頂きました。
こちらの手元で正常に動作する確認をしてから提示しています。データとの不整合なのでしょう。
他の方からも回答が寄せられていますし、私のは打っちゃっておいて構いません。
それに、エラーが出ます、だけでは手の打ちようがありません。
エラーの個所、そのときの関連データの状況を明確にして確認する作業が必要です。
データが想定したものと違うのでしょう。そちらで確認調査していただくしかありません。
（よくあるのは、空白とみえてスペース文字が入っていたとか、そのようなことが多いです）
 
さて、いくつか質問していいですか？
２〜３秒かかっているとのことですが、
・対象データの量は示されたものですか？それとももっと行数が多いものですか？
・計測はどのようにして行いましたか？
それらについて、明確な回答をいただきたいです。
提示されたデータであれば、想定では1秒もかからず、
たぶんミリ秒単位の瞬時に終了するレベルのものだと思っています。
（これはほかの回答者さんからも指摘があり、私も同感です。）
 
まずは、そこの懸隔を埋めていく方向で検討するのがよいと思います。

引用:
掲示いただいたmyCONCATを入れてステップ実行したところ
  
gokei = gokei + myCONCAT(.Cells(RX, "B").Resize(, 9).Value)
  
で「型が違います」のエラーメッセージが出ます

９行目で時間が掛かる件
と
型が違うエラーの件
は、根っこは同じものと思います。
 
こちらでテストしたところ
９行目のＢ〜Ｊのどこかのセルに数字以外の文字列が入っているような気がします。
 
myCONCATプロシジャの中をステップ実行してみてください。
それでも、分からなかったら、
この中の、１文字＜＞空白文字列という条件を、
数字のみという条件に変えて実行してみてください。
 

引用:
イベント処理はまだ一つも入れていません

引用:
Application.EnableEvents = False
は入れました
実行速度は変わりません

引用:
が表示され何も書き込まれません

引用:
合計を出す所までの案を、2案ほど。

WinArrow さんの引用:
９行目で時間が掛かる件
と
型が違うエラーの件
は、根っこは同じものと思います。
 
こちらでテストしたところ
９行目のＢ〜Ｊのどこかのセルに数字以外の文字列が入っているような気がします。
 
myCONCATプロシジャの中をステップ実行してみてください。
それでも、分からなかったら、
この中の、１文字＜＞空白文字列という条件を、
数字のみという条件に変えて実行してみてください。
 

WinArrowさん
> B9:J9は4行目から8行目の各行を足した計算結果が入ります
代入セル（結果セル）です

blue_cars さんの引用:
WinArrowさん
> B9:J9は4行目から8行目の各行を足した計算結果が入ります
代入セル（結果セル）です

 WinArrowさん
 
>シートの中に、揮発性関数を使ていますか？
１つも使っていません

こんばんは
スレの流れ，空気をまったく読んでいませんが，
お遊びのコードです(ふざけているわけではないです)。
 

Sub 多分10000桁でもOK_※未検証です()

    ' ・ただし結果の値には前ゼロが入る
    ' ・限界もある(一時的に格納されるセルの値が整数で
    '   表現できる範囲(15桁くらい?)でないとダメ)
    '   999,999,999,999,999 / 9 = 111,111,111,111,111 行
    '   くらいまではOK(ホントか?)
    ' ・直接セルの値を使用するので大きな桁数、行数では遅いです
    
    Dim rng As Excel.Range
    Dim yi  As Long
    Dim xi  As Long
    Dim cy  As Long     ' キャリー
    Dim ti  As Long     ' 合計行
    
    Dim tm  As Double
    
    tm = Timer()
    
''  Application.ScreenUpdating = False
    
    Set rng = Sheet1.Range("B4:J8")
    
    ' 合計行を初期化
    Call rng.Offset(rng.Rows.Count).Resize(1).ClearContents
    
    ti = rng.Rows.Count + 1 ' 合計行(rng の範囲の次の行)
    
    For xi = rng.Columns.Count To 1 Step -1
        ' 各桁の合計処理
        For yi = 1 To rng.Rows.Count
            rng.Cells(ti, xi).Value = rng.Cells(ti, xi).Value _
                                    + rng.Cells(yi, xi).Value
        Next yi

        ' 桁の値の抽出・繰上げ処理
        cy = rng.Cells(ti, xi).Value \ 10
        
        If (cy <> 0) Then
            If (xi = 1) Then
                ' 最上位桁で繰上げが発生
                Call MsgBox("オーバーフロー", vbCritical)
            
            Else
                rng.Cells(ti, xi).Value = rng.Cells(ti, xi).Value Mod 10
                rng.Cells(ti, xi - 1).Value = rng.Cells(ti, xi - 1).Value + cy
            End If
        End If
    Next xi

    Set rng = Nothing

''  Application.ScreenUpdating = True

    Debug.Print Format(Timer() - tm, "0.000") & "secs."

End Sub

たらのりさん
コードの結果ですが
2回走らせて
8.266secs.
5.203secs.
結果セルには書き込まれません

こちらで作成したサンプルシートでは、たらのりさんのや他の方のコードで問題なく実行できて、0.1秒もかかりません。
もはや、そのシートになにか呪いがかかっているとしか思えません。
 
新規ブックを作成して、そこのSheet1で質問のデータを入力して、みなさんの提示されたコードを試したとき、どうなりますか。

hatena さん，
フォローありがとうございます。
 
未検証とはいえ，さすがに例示されたケース(和が 6357)くらいは
動作確認をしました(あと 50桁くらいでも)。
 
当のシートの 9行めが非表示になっていたり，フォントの色が白だったり
しませんか? (失礼なもの言いでスミマセン)
 
あと，僕もよく Excelのおかしな挙動に遭遇し，給湯室でボヤくことも
多いので，質問者さんの瑕疵でない何かがある可能性もあります。
 
 

おもしろそうだったので、
たらのりさんの桁毎に計算して繰り上がり処理をするというアイデアを拝借してコードを書いてみました。
 
他にも、
CurrentRegionを利用して数値のある範囲のみを対象にする。
桁毎の合計はSum関数を使う。
というアイデアも追加しました。
 

Sub ColumnSum()
    Dim rng As Range
    Set rng = Range("J4").CurrentRegion
    ReDim arySum(1 To rng.Columns.Count)
    Dim carry As Long
    Dim i As Long
    For i = rng.Columns.Count To 1 Step -1
         carry = WorksheetFunction.Sum(rng.Columns(i)) + carry
         arySum(i) = carry Mod 10
         carry = carry \ 10
    Next
    Set rng = rng.Offset(rng.Rows.Count).Resize(1)
    rng.Value = arySum   

    i = rng.Cells(1).Column - 1
    Do Until carry = 0 Or i < 1
        Cells(9, i) = carry Mod 10
        carry = carry \ 10
        i = i - 1
    Loop
End Sub

'速度計測用ルーチン
Sub SpeedTest()
    Range("A9:J9").ClearContents
    
    Dim t As Single
    t = Timer
    
    Call ColumnSum

    Debug.Print Format(Timer() - t, "0.000") & "secs."
End Sub

ブックの中に「リンクされた図」がありませんか?
それが存在するとVBAの速度が一気に遅くなるというのを前に体験しました。
(ScreenUpdatingやCalculation,EnableEvents を入れても効かない)

引用:
さて、いくつか質問していいですか？
２〜３秒かかっているとのことですが、
・対象データの量は示されたものですか？それとももっと行数が多いものですか？
・計測はどのようにして行いましたか？
それらについて、明確な回答をいただきたいです。

みなさん
ありがとうございます
新規ワークブック.xlsm に同じセル範囲に同じデータを手打ちして試してみました
 
simpleさんのtest 型が一致しません
質問の意図を読み取れていなくて混乱させていましたら申し訳ありません
 
> ・対象データの量は示されたものですか？それとももっと行数が多いものですか？
今までの検証しているのはすべて同じ最初に質問したデータです
ただし、質問時に使用しているシートにはほかの場所にもデータがあるので
そのことをおっしゃっているとしたら連続してはいませんがもっと行数が多いものとなります
 
> ・計測はどのようにして行いましたか？
Debug.Print Format(Timer() - myTime1, "0.000") & "secs."
で行っています
 
SuzuさんのTest03 Ansは、5801 処理時間は 0m秒
 
SuzuさんのTsst04 Ansは、5801 処理時間は 0m秒
 
たらのりさんの多分10000桁でもOK_※未検証です 0.008secs.(000006357と0埋めされて書き込み)
 
hatenaさんのSpeedTest 0.000secs. 6357と正常に書き込み
ただし、質問時に使用しているシートにははほかの場所にもデータがあるので
CurrentRegionは使えない？のかなと思いました（知識不足なので間違っていたらすいません）
 
自分で書いたコード 33907.470secs.
 
 
abecさん、「リンクされた図」はあります
もしかしてこれが決定的な原因なのかも？

引用:
abecさん、「リンクされた図」はあります
もしかしてこれが決定的な原因なのかも？

引用:
abecさん、「リンクされた図」はあります
もしかしてこれが決定的な原因なのかも？

Dim Data
    Data = Split(Format(6357, "@,@,@,@,@,@,@,@,@"), ",")
    With Range("B9:J9")
        .NumberFormatLocal = "G/標準"
        .Value = Data
        .Value = .Value
    End With

Suzuさん
WinArrowさん
今出先なので戻ったら検証してみます

simple さんの引用:
また、既に他の方からも指摘があったかと思いますが、
新しいブックに、今のシートの数字部分だけを再入力して（決してコピーペイストは使わない）、
事象が再現するか確認して、これも回答をいただけますか。

こんにちは(?)
ずいぶん日が長くなりました。
 
> > ・計測はどのようにして行いましたか？
> Debug.Print Format(Timer() - myTime1, "0.000") & "secs."
> で行っています
 
> 自分で書いたコード 33907.470secs.
 
これ，処理の開始時に次のコードがないですね：
 

myTime1 = Timer()

' ■ 修正前
        ' 桁の値の抽出・繰上げ処理
        cy = rng.Cells(ti, xi).Value \ 10       ' ★ 高価な除算
        
        If (cy <> 0) Then
            If (xi = 1) Then
                ' 最上位桁で繰上げが発生
                Call MsgBox("オーバーフロー", vbCritical)
            
            Else
                rng.Cells(ti, xi).Value = rng.Cells(ti, xi).Value Mod 10
                rng.Cells(ti, xi - 1).Value = rng.Cells(ti, xi - 1).Value + cy
            End If
        End If

' ■ 修正後
        ' 桁の値の抽出・繰上げ処理
'''     cy = rng.Cells(ti, xi).Value \ 10       ' ★ 高価な除算は

        If (rng.Cells(ti, xi).Value > 9) Then   ' 繰り上がり発生?
            If (xi = 1) Then
                ' 最上位桁で繰上げが発生
                Call MsgBox("オーバーフロー", vbCritical)
            
            Else
                cy = rng.Cells(ti, xi).Value \ 10   ' ★ なるべく回避(ココで)
                rng.Cells(ti, xi).Value = rng.Cells(ti, xi).Value Mod 10
                rng.Cells(ti, xi - 1).Value = rng.Cells(ti, xi - 1).Value + cy
            End If
        End If

投稿日時: 24/03/23 11:18:59
投稿の参考コードは、「@」で変換したスペース1文字が
セルにそのまま代入されてしまうので、
コードを変更します。

Dim Data

    Data = Format(6357, "@,@,@,@,@,@,@,@,@")
    Data = Split(Replace(Data, " ", ""), ",")
    With Range("B9:J9")
        .ClearContents
        .NumberFormatLocal = "G/標準"
        .Value = Data
        .Value = .Value
    End With

たらのりさん
自分にはちょっと高度で理解が追い付いていません
 
Suzuさん
abecさん
simpleさん
（意図を読み取れなくて申し訳ありません）
 
>では、当該ファイルをコピーし
>そのコピーしたファイルにおいて、そのリンク図を削除し
>テストしてみた場合はどうでしょう？
 
ほとんど速度に変わりありませんでした(汗
これが原因であってほしかった．．．
  
それで、SuzuさんとWinArrowさんからいただいた案を合体させたような
（他の方のご意見も参考にして）コードがこれで
処理時間は 0m秒となっております
WinArrowさん
> 個々のセルに代入するより
> セル範囲に一挙に代入した方が、時間が科からにと思いますので
こういう方法があるんですね
また、@の部分は空白が入っていたの気が付いていませんでした
  
Option Explicit
Sub test02()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
   
  Dim TempData As Variant
  Dim Ans As Long
  Dim i As Long
  Dim j As Long
   
  Dim sTime As Long
  Dim eTime As Long
    
  Dim DATA
   
  sTime = Timer
  TempData = Range("B4:J9").Value
  For i = LBound(TempData, 1) To UBound(TempData, 1)
    For j = UBound(TempData, 2) To LBound(TempData, 2) Step -1
      Ans = Ans + 10 ^ (UBound(TempData, 2) - j) * TempData(i, j)
    Next
  Next i
      
    DATA = Format(Ans, "@,@,@,@,@,@,@,@,@")
    DATA = Split(Replace(DATA, " ", ""), ",")
    With Range("B10:J10")
        .NumberFormatLocal = "G/標準"
        .Value = DATA
        .Value = .Value
    End With
      
  eTime = Timer
   
  Debug.Print "値は、" & CStr(Ans) & " 処理時間は " & eTime - sTime & "m秒"
  
     
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  Application.EnableEvents = True
      
End Sub

引用:

また、@の部分は空白が入っていたの気が付いていませんでした

追加レス
 

引用:
Dim sTime As Long

WinArrowさん
> ところで、処理時間は、どうなりましたか？
  Dim sTime As Single
  Dim eTime As Single
と直しました
 
値は、6357 処理時間は 0.5秒
値は、6357 処理時間は 0.5625秒
値は、6357 処理時間は 0.546875秒

いえいえ，
こちらこそすみません。
 
後半は業務連絡(?)のようなものなので，スルー前提です。
 
スレ汚し，スミマセンでした……
 
 

blue_cars さんの引用:
WinArrowさん
> ところで、処理時間は、どうなりましたか？
  Dim sTime As Single
  Dim eTime As Single
と直しました
 
値は、6357 処理時間は 0.5秒
値は、6357 処理時間は 0.5625秒
値は、6357 処理時間は 0.546875秒

WinArrowさん
 
検証１回目
「リンクされた図あり」
Befor：値は、 6357 処理時間は 1.46875秒
After：値は、6357 処理時間は 0.6875秒
 
「リンクされた図なし」
Befor：値は、 6357 処理時間は 1.664063秒
After：値は、6357 処理時間は 0.75秒
 
 
検証２回目
「リンクされた図あり」
Befor：値は、 6357 処理時間は 2.40625秒
After：値は、6357 処理時間は 1.132813秒
 
「リンクされた図なし」
Befor：値は、 6357 処理時間は 1.703125秒
After：値は、6357 処理時間は 0.796875秒
 
この結果だと「リンクされた図」の影響もありますね
だいぶ速くなっているのですが．．．

だいぶ早くなったことですが、
納得していない様子・・・・
 
こちらでテストの結果、
勿論、「リンクされた図」はなし（同じ状態は設定できないから）
処理時間は、0.0625秒です。
 
まだ、何か、説明していないことがありそうですね？
説明していない部分が足をひっぱっていると思われます。
 
他の回答者からアドバイスがあるように
全く新しいブックに、説明されているデータだけを複写して
テストすることをお勧めします。
 
 

処理時間を訂正します。
誤：0.0625
正：0秒
です。
５回ほど実行して検証しました。

新規ブックで検証
「リンクされた図なし」
Befor：値は、 6357 処理時間は 0.953125秒
After：値は、6357 処理時間は 0.484375秒
 
「リンクされた図あり」
Befor：値は、 6357 処理時間は 1.152344秒
After：値は、6357 処理時間は 0.53125秒
 
> まだ、何か、説明していないことがありそうですね？
> 説明していない部分が足をひっぱっていると思われます。
あるとしたら罫線があったり２か所同じシート上のセルから
=IF(N2="","",N2)のように同じ値を表示している部分ですかね？
あとは計算式も何もない手打ちするシートなのです。
実際のブックアップできるならどこかにアップして見てもらっても良いのですが。
計算式を入れることができないので合計だけvbaで計算できたらと思い
今に至るということなのです。
 
 

事務所のPCは、
32Bit対応ですか？
64Bit対応ですか？
 
アドイン
は、組み込んでありますか？
 
 
 

WinArrowさん
 
> 事務所のPCは、
> 32Bit対応ですか？
> 64Bit対応ですか？
本日休みで確認できないのですが
Excelが
Microsoft® Excel® 2016 MSO (バージョン 2402 ビルド 16.0.17328.20124) 32 ビット
なのですが32Bit対応ということになるのでしょうか？
  
> アドイン
> は、組み込んでありますか？
アドインは組み込んでいないと思います

引用:

なのですが32Bit対応ということになるのでしょうか？

hatenaさん
simpleさん
Suzuさん
skさん
たらのりさん
abecさん
WinArrowさん
 
当初自分の書いたものより
速度改善・ご指導していただけました
長くなってしまいましたので
これでいったんこのスレッドは閉じたいと思います
 
ありがとうございました