Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ABZBB
- A x 1
- B x 3
- Z x 1
- Sub Macro1()
- Dim Box As Shape
- Set Box = ActiveDocument.Shapes.AddTextbox( _
- Orientation:=msoTextOrientationHorizontal, _
- Left:=50, Top:=50, Width:=200, Height:=400)
- Box.TextFrame.TextRange.Text = "My text comes this way" + Chr(10)
- Dim s As String
- Application.ScreenUpdating = False
- docLength = ActiveDocument.Range.Characters.Count
- Box.TextFrame.TextRange.Text = Box.TextFrame.TextRange.Text + "Text length is: " + Str(docLength) + Chr(10)
- Dim arr(128) As Integer
- Dim character As Integer
- For i = 1 To docLength - 1
- character = Asc(ActiveDocument.Range.Characters(i))
- If iAsc >= 0 And iAsc <= 127 Then
- arr(character) = arr(character) + 1
- End If
- Next i
- End Sub
- Sub CountChars()
- Dim iCount(57) As Integer
- Dim x As Integer
- Dim iTotal As Integer
- Dim iAsc As Integer
- Application.ScreenUpdating = False
- iTotal = ActiveDocument.Range.Characters.Count
- For x = 1 To iTotal
- iAsc = Asc(ActiveDocument.Range.Characters(x))
- If iAsc >= 65 And iAsc <= 122 Then
- iCount(iAsc - 65) = iCount(iAsc - 65) + 1
- End If
- Next x
- For x = 0 To 57
- Debug.Print x, iCount(x)
- Next x
- Application.ScreenUpdating = True
- End Sub
- Debug.Print Chr(x + 65), iCount(x)
- 'Tools, References: Microsoft Scripting Runtime
- Sub CountCharsWithReplace()
- Dim doc As Document
- Dim rDupe As Range
- Dim dicChars As Scripting.Dictionary
- Dim s As String
- Dim iTotalChars As Integer
- Dim iTempChars As Integer
- Dim iDiff As Integer
- Dim n As Integer
- Dim blnExec As Boolean
- Dim lett As Variant
- Application.ScreenUpdating = False
- Set doc = ActiveDocument
- iTotalChars = doc.Range.Characters.Count
- Set rDupe = doc.Range
- Set dicChars = New Scripting.Dictionary
- Do While rDupe.Characters.Count > 1
- s = rDupe.Characters(1).Text
- blnExec = rDupe.Find.Execute(s, , , , , , , , , "", wdReplaceAll)
- iTempChars = doc.Range.Characters.Count
- iDiff = iTotalChars - iTempChars
- iTotalChars = iTempChars
- If Asc(s) >= 65 And Asc(s) <= 122 Then
- dicChars.Add s, iDiff
- End If
- n = n + 1
- Loop
- ActiveDocument.Undo Times:=n
- Application.ScreenUpdating = True
- For Each lett In dicChars.Keys
- Debug.Print lett, dicChars(lett)
- Next lett
- End Sub
- ActiveDocument.Range.ComputeStatistics(wdStatisticCharacters)
- Activedocument.Range.Characters.Count
- Selection.Range.ComputeStatistics(wdStatisticCharacters)
- Selection.Range.Characters.Count
- Function GetCharCountLoop(doc As Word.Document, char As String) As Long
- Dim i As Long
- Dim CharCount As Long
- With doc.Content.Characters
- For i = 1 To .Count
- If .Item(i) = char Then
- CharCount = CharCount + 1
- End If
- Next i
- End With
- GetCharCountLoop = CharCount
- End Function
- Function GetCharCountFind(doc As Word.Document, char As String) As Long
- Dim i As Long
- Dim CharCount As Long
- With doc.Content.Find
- Do While .Execute(FindText:=char, Forward:=True, MatchWholeWord:=False, MatchCase:=True) = True
- CharCount = CharCount + 1
- Loop
- GetCharCountFind = CharCount
- End With
- End Function
- Function GetCharCountString(doc As Word.Document, char As String) As Long
- Dim chars As String
- Dim i As Long
- Dim CharCount As Long
- chars = doc.Content
- For i = 1 To Len(chars)
- If Mid$(chars, i, 1) = char Then
- CharCount = CharCount + 1
- End If
- Next i
- GetCharCountString = CharCount
- End Function
- Function GetCharCountRegex(doc As Word.Document, char As String) As Long
- Dim chars As String
- Dim CharCount As Long
- Dim objRegExp As Object
- chars = doc.Content
- Set objRegExp = CreateObject("VBScript.RegExp")
- With objRegExp
- .Pattern = char
- .IgnoreCase = False
- .Global = True
- CharCount = .Execute(chars).Count
- End With
- GetCharCountRegex = CharCount
- End Function
- Sub TimeMethods()
- Dim char As String
- Dim CharCount As Long
- Dim LoopCounter As Long
- Dim NumLoops As Long
- Dim StartTime As Double
- char = "a"
- NumLoops = 1
- StartTime = Timer
- For LoopCounter = 1 To NumLoops
- CharCount = GetCharCountLoop(ActiveDocument, char)
- Next LoopCounter
- Debug.Print CharCount
- Debug.Print Timer - StartTime
- StartTime = Timer
- For LoopCounter = 1 To NumLoops
- CharCount = GetCharCountFind(ActiveDocument, char)
- Next LoopCounter
- Debug.Print CharCount
- Debug.Print Timer - StartTime
- StartTime = Timer
- For LoopCounter = 1 To NumLoops
- CharCount = GetCharCountString(ActiveDocument, char)
- Next LoopCounter
- Debug.Print CharCount
- Debug.Print Timer - StartTime
- StartTime = Timer
- For LoopCounter = 1 To NumLoops
- CharCount = GetCharCountRegex(ActiveDocument, char)
- Next LoopCounter
- Debug.Print CharCount
- Debug.Print Timer - StartTime
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement