martedì 16 luglio 2013

ricerca parole tag

Attribute VB_Name = "ricerca_parole_tag"

'

Option Explicit

'

' vba - Excel.

' trova parole/tag in una colonna di Excel.

' tramite espressione regolare crea

' elenco della parole presenti in una colonna.

' Evita i duplicati.

'

Sub TrovaParoleTag()

Dim quanterighe, contarighe, foglio, contenuto As String, colonnaDaLeggere, trovate As String, parole

Dim objRegEx, paroletrovate, parola

Set foglio = Sheets(ActiveSheet.Name)

Set objRegEx = CreateObject("VBScript.RegExp")

objRegEx.Global = True

'

' conteggio delle righe utilizzare

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

colonnaDaLeggere = "D" ' colonna contenete celle da leggere

'

contarighe = 1 ' parte dalla prima riga

contenuto = ""

trovate = ""

While contarighe <= quanterighe

' carica il contenuto della cella

contenuto = " " & foglio.Cells(contarighe, colonnaDaLeggere).Value & " "

'

objRegEx.Pattern = "\w+" ' ricerca parole

Set paroletrovate = objRegEx.Execute(contenuto)

'

If paroletrovate.Count > 0 Then ' conteggio delle parole trovate

For Each paroletrovate In paroletrovate

parola = paroletrovate.Value

'

objRegEx.Pattern = parola

' verifca che la parola sia memorizzata

If objRegEx.test(trovate) = False Then

trovate = trovate & " " & parola

End If

'

Next

End If

'

contarighe = contarighe + 1

foglio.Cells(contarighe, colonnaDaLeggere).Activate

Wend

'

' che nuovo foglio contenente le parole trovate

parole = Split(trovate, " ")

Dim quanteparole, contaparole

Sheets.Add

quanteparole = UBound(parole)

For contaparole = 0 To quanteparole

ActiveSheet.Cells((contaparole + 1), "A").Value = parole(contaparole)

Next contaparole

'

End Sub

'

Nessun commento:

Posta un commento