Oscar Sun

                    Sub 選取範圍汰重字()
Dim r As Range, c As Object, ca As Object, t As Long
Set r = Selection.Range
For Each c In Selection.Range.Characters
    For Each ca In r.Characters
        If StrComp(c, ca) = 0 Then
            t = t + 1
            If t > 1 Then
'                ca.Select
                ca.Delete
                t = 1
            End If
        End If
    Next
    t = 0
Next
MsgBox "done!", vbInformation
End Sub


                  

                    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

                  

                    Visual Studio 在編輯VB碼時出現的「參考非共用成員需要物件參考。」
其實只是說所引用的物件方法或屬性,得用個物件變數先做指定,然後再在程式中呼叫引用其方法、屬性。(此為「物件參考」之意,將物件變數指定給某物件的動作,即為參考)
「共用成員」大概是全域通用的公用變數或全域變數的意思。
本來用DAO不行,用ADO才行;出現的便是此「參考非共用成員需要物件參考。」的訊息,很困擾。網上略搜也不見說明。後來靈機一動,原來用物件變數來引用看看,不要直接引用物件類別本身,如 ,果然就通了。
如
Static db As DAO.Database
Dim od As New DAO.DBEngine
db = od.OpenDatabase("兩岸用語對照.mdb") '相對路徑
要先宣告變數再予指定參考
不能直接寫成:
db = DAO.DBEngine.OpenDatabase("\兩岸用語對照.mdb")
這樣寫便會出現「參考非共用成員需要物件參考。」的錯誤
有點像不能直接引用實物,要用代數或參數來間接引用才行。
‪#‎Visual_Studio‬
‪#‎Visual_Basic‬

https://www.facebook.com/oscarsun72/posts/568121119965693
                  

                    Sub 倉頡碼變速成碼()
Dim p As Paragraph, rng As Range
Set rng = ThisDocument.Paragraphs(1).Range
For Each p In ThisDocument.Paragraphs
    i = i + 1
    If i > 10 Then
        xp = p.Range
        s = InStr(xp, " ")
        If s > 3 Then
           
                rng.SetRange p.Range.Characters(2).Start, p.Range.Characters(s - 2).End
                rng.Delete
           
        End If
    End If
Next p
End Sub

                  

                    Sub 刪除重覆詞條()
Dim d1 As Document, d2 As Document, p As Paragraph
Set d1 = Documents(1) '刪據
Set d2 = Documents(2) '被刪
For Each p In d1.Paragraphs
    If d2.Range.Find.Execute(p.Range) = True Then
        d2.Range.Find.Execute p.Range, , , , , , , , , ""
    End If
Next p
End Sub