Come inserire in B un elenco delle parole ricorrenti presenti in A:A

20 views
Skip to first unread message

Marco

unread,
Sep 29, 2021, 5:56:08 AM9/29/21
to
Ciao a tutti,
ponendo di avere in A:A, a partire da A1 e fino a quale riga non si sa (può cambiare di volta in volta), come posso fare per avere in B un elenco delle parole più ricorrenti, in ordine appunto di ricorrenza? Per esempio avere in cima la parola che compare di più nella colonna A:A, in seconda posizione la seconda parola che compare di più e così via
Voi come fareste? Esiste qualcosa di già pronto che mi sfugge?
Grazie

Bruno Campanini

unread,
Sep 29, 2021, 11:29:43 AM9/29/21
to
Marco has brought this to us :
Non è edsattamente la disposizione richiesta,
ma il risultato è congruente.
====================================================
Public Sub CountDups_VBA()
'
' Excel 2019 29-09-2021 BB.xlsm Module: BC
'
' Ricopia i duplicati relativi a una colonna determinandone il numero.
' I valori unici non vengono copiati
'
Dim Destination As Range, SheetName As String, StartCell As Range
Dim UniqueColl As New Collection, SourceRange As Range, i, j, k As Long
Dim SortRange As Range

'--- Definizioni ------------
Set StartCell = [Freq!A1]
Set Destination = [Freq!C1]
'------------------------------

Set SourceRange = Range(StartCell, StartCell.End(xlDown))
For Each i In SourceRange
On Error GoTo DupErr
UniqueColl.Add i, CStr(i)
Continue:
Next

Set SortRange = Range([Freq!C1], [Freq!C1].End(xlDown).End(xlToRight))
SortRange.Sort _
Key1:=[D1], _
Order1:=xlDescending, _
Orientation:=xlSortColumns, _
MatchCase:=True

Exit Sub

DupErr:
On Error GoTo 0
For Each j In Destination
If i = j Then
j(1, 1) = i
j(1, 2) = j(1, 2) + IIf(j(1, 2) = 0, 2, 1)
Resume Continue
End If
Next
k = k + 1
Destination(k, 1) = i
Destination(k, 2) = Destination(k, 2) + IIf(Destination(k, 2) = 0,
2, 1)
If Not IsEmpty(Destination(1)) And Not IsEmpty(Destination(2)) Then
Set Destination = Range(Destination(1),
Destination(1).End(xlDown))
End If
Resume Continue

End Sub

Bruno

Marco

unread,
Sep 29, 2021, 11:57:47 AM9/29/21
to
ciao e grazie per la risposta: mi da però errore qui
Destination(k, 2) = Destination(k, 2) + IIf(Destination(k, 2) = 0,
pensavo fosse la doppia I di IF ma da errore anche con una sola...
puoi verificare per favore? Grazie

Bruno Campanini

unread,
Sep 30, 2021, 4:54:50 AM9/30/21
to
Marco presented the following explanation :
La verifica l'avevo già fatta prima di inviarti la procedura...
Comunque l'ho ripetuta a da me (Win 10 Pro e Office 2019 64bit)
funziona regolarmente.

Ti elenco le References attivate:
1 - Visual Basic For Applications
2 - Microsoft Excel 16.0 Object Library
3 - OLE Automation
4 - Mocrosoft Office 16.0 Object Library
5 - Microsoft Sceipting Runtime
6 - Microsoft Forms 2.0 Object Library
7 - Microsoft VBScript Regular Expression 5.5
8 - Microsoft CDO for Windows 2000 Library
9 - Microsoft Office 16.0 Access database engine Object Library

Ma non tutte sono necessarie alla procedura in oggetto:
sicuramente lo sono le 1, 2, 4, 9.

Non so che altro pensare.

Bruno

Bruno Campanini

unread,
Sep 30, 2021, 4:58:37 AM9/30/21
to
Bruno Campanini presented the following explanation :
Avendo compilato 100 celle (A1:A100) con le 26 lettere dell'alfabeto,
questo è il risultato che ottengo con la procedura:

G 13
D 10
T 7
F 6
W 6
H 6
R 6
S 5
Y 4
E 4
A 4
C 3
V 3
Q 3
N 2
Z 2
X 2
J 2
I 2
O 2
P 2
K 2

Bruno
Reply all
Reply to author
Forward
0 new messages