Oscar Sun

                  Attribute VB_Name = "橫排數值加總"
Option Explicit

Sub 橫排數值加總()
On Error GoTo eH
Dim a As Long, e As Object, s As Long, ee As Long, rng As Range, c As Object, clmn As Range
Set rng = ActiveSheet.UsedRange
Set clmn = rng.Columns(ActiveCell.Column)
Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
'ActiveCell.Insert
'Set rng = ActiveCell.Column
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromRightOrBelow
'Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
'Selection.Columns(1).Index

For Each c In clmn.Cells
    For s = 1 To Len(c.Text)
        If c.Characters.Count = 1 Then
            If IsNumeric(c.Text) Then a = c.Text
        ElseIf c.Characters.Count > 1 Then
            If IsNumeric(c.Characters(s, 1).Text) Then a = a + c.Characters(s, 1).Text
        End If
    Next
    c.Next = a
    a = 0
Next c

Exit Sub
eH:
Select Case Err.Number
    Case 5904, 1004 '無法取得類別 Characters 的 Text 屬性
        Resume Next
    Case Else
        MsgBox Err.Number & Err.Description
        Debug.Print Err.Number & Err.Description
        Resume
End Select

'On Error GoTo eH '以下word原式
'Dim d As Document, a As Long, e As Object, s As Long, ee As Long, rng As Range
'Set d = ActiveDocument
'
'For Each e In d.Characters
'    If Not IsNumeric(e) Then e.Delete
'Next
'For Each e In d.Characters
'    If IsNumeric(e) Then a = a + e
'Next
'With d.ActiveWindow
'    Set rng = d.Range
'    d.Range.InsertParagraphAfter
'    s = d.Range.End - 2
'    .Selection.TypeText "加總結果 =" & a
'    ee = d.Range.End
'    rng.SetRange s, ee
'    rng.HighlightColorIndex = wdYellow
'    .ScrollIntoView rng, False
'    MsgBox "加總結果 =" & a
'End With
'Exit Sub
'eH:
'Select Case Err.Number
'    Case 5904
'        Resume Next
'    Case Else
'        MsgBox Err.Number & Err.Description
'End Select
End Sub