User Tag List

Ցույց են տրվում 7,006 համարից մինչև 7,020 համարի արդյունքները՝ ընդհանուր 8242 հատից

Թեմա: Հարցեր համակարգչային ծրագրերի վերաբերյալ, խնդրում եմ շտապ օգնել

Ծառի տեսքով դիտում

Նախորդ գրառումը Նախորդ գրառումը   Հաջորդ գրառումը Հաջորդ գրառումը
  1. #11
    Պապա x3 Աթեիստ-ի ավատար
    Գրանցման ամսաթիվ
    26.05.2007
    Հասցե
    Հայաստան
    Տարիք
    47
    Գրառումներ
    8,712
    Mentioned
    50 Post(s)
    Tagged
    1 Thread(s)
    Կոդ:
    Sub WordFrequency()    Const maxwords = 9000          'Maximum unique words allowed
        Dim SingleWord As String       'Raw word pulled from doc
        Dim Words(maxwords) As String  'Array to hold unique words
        Dim Freq(maxwords) As Integer  'Frequency counter for unique words
        Dim WordNum As Integer         'Number of unique words
        Dim ByFreq As Boolean          'Flag for sorting order
        Dim ttlwds As Long             'Total words in the document
        Dim Excludes As String         'Words to be excluded
        Dim Found As Boolean           'Temporary flag
        Dim j, k, l, Temp As Integer   'Temporary variables
        Dim ans As String              'How user wants to sort results
        Dim tword As String            '
    
    
        ' Set up excluded words
        ' Excludes = "[the][a][of][is][to][for][by][be][and][are]"
    
    
        ' Find out how to sort
        ByFreq = True
        ans = InputBox("Sort by WORD or by FREQ?", "Sort order", "WORD")
        If ans = "" Then End
        If UCase(ans) = "WORD" Then
            ByFreq = False
        End If
        
        Selection.HomeKey Unit:=wdStory
        System.Cursor = wdCursorWait
        WordNum = 0
        ttlwds = ActiveDocument.Words.Count
    
    
        ' Control the repeat
        For Each aword In ActiveDocument.Words
            SingleWord = Trim(LCase(aword))
            'Out of range?
            'If SingleWord < "a" Or SingleWord > "z" Then
            '    SingleWord = ""
            'End If
            'On exclude list?
            If InStr(Excludes, "[" & SingleWord & "]") Then
                SingleWord = ""
            End If
            If Len(SingleWord) > 0 Then
                Found = False
                For j = 1 To WordNum
                    If Words(j) = SingleWord Then
                        Freq(j) = Freq(j) + 1
                        Found = True
                        Exit For
                    End If
                Next j
                If Not Found Then
                    WordNum = WordNum + 1
                    Words(WordNum) = SingleWord
                    Freq(WordNum) = 1
                End If
                If WordNum > maxwords - 1 Then
                    j = MsgBox("Too many words.", vbOKOnly)
                    Exit For
                End If
            End If
            ttlwds = ttlwds - 1
            StatusBar = "Remaining: " & ttlwds & ", Unique: " & WordNum
        Next aword
    
    
        ' Now sort it into word order
        For j = 1 To WordNum - 1
            k = j
            For l = j + 1 To WordNum
                If (Not ByFreq And Words(l) < Words(k)) _
                  Or (ByFreq And Freq(l) > Freq(k)) Then k = l
            Next l
            If k <> j Then
                tword = Words(j)
                Words(j) = Words(k)
                Words(k) = tword
                Temp = Freq(j)
                Freq(j) = Freq(k)
                Freq(k) = Temp
            End If
            StatusBar = "Sorting: " & WordNum - j
        Next j
    
    
        ' Now write out the results
        tmpName = ActiveDocument.AttachedTemplate.FullName
        Documents.Add Template:=tmpName, NewTemplate:=False
        Selection.ParagraphFormat.TabStops.ClearAll
        With Selection
            For j = 1 To WordNum
                .TypeText Text:=Trim(Str(Freq(j))) _
                  & vbTab & Words(j) & vbCrLf
            Next j
        End With
        System.Cursor = wdCursorNormal
        j = MsgBox("There were " & Trim(Str(WordNum)) & _
          " different words ", vbOKOnly, "Finished")
    End Sub
    Էս մակրոն հարկավոր ա տեղադրել փաստաթղթում ու աշխատեցնել։
    artak.am De gustibus et coloribus non est disputandum.

  2. Գրառմանը 1 հոգի շնորհակալություն է հայտնել.

    Varzor (22.05.2012)

Թեմայի մասին

Այս թեման նայող անդամներ

Այս պահին թեմայում են 1 հոգի. (0 անդամ և 1 հյուր)

Համանման թեմաներ

  1. Հարցեր համակարգչային գրաֆիկայի վերաբերյալ
    Հեղինակ՝ Ուլուանա, բաժին` Համակարգչային գրաֆիկա
    Գրառումներ: 26
    Վերջինը: 05.12.2020, 12:56
  2. Հարցեր և պատասխաններ համակարգչային ցանցերի վերաբերյալ
    Հեղինակ՝ Cracker, բաժին` Համակարգչային ցանցեր
    Գրառումներ: 723
    Վերջինը: 13.05.2017, 01:10
  3. Հարց, խնդրում եմ օգնել
    Հեղինակ՝ Մուշեղ Ասատրյան, բաժին` Թատրոն
    Գրառումներ: 0
    Վերջինը: 23.05.2009, 23:53
  4. Խնդրում եմ շտապ օգնել... հարկավոր է նոր բառ
    Հեղինակ՝ Վարպետ, բաժին` Հայերեն
    Գրառումներ: 56
    Վերջինը: 20.04.2009, 17:04
  5. Խնդրում եմ օգնել
    Հեղինակ՝ HNK511, բաժին` Հայտարարություններ
    Գրառումներ: 6
    Վերջինը: 01.02.2008, 14:30

Թեմայի պիտակներ

Էջանիշներ

Էջանիշներ

Ձեր իրավունքները բաժնում

  • Դուք չեք կարող նոր թեմաներ ստեղծել
  • Դուք չեք կարող պատասխանել
  • Դուք չեք կարող կցորդներ տեղադրել
  • Դուք չեք կարող խմբագրել ձեր գրառումները
  •