Calcul de moyenne sur des résultats obtenus par échelle de likert
Bonjour
je soumets à vos lumières un calcul automatique de moyenne de données numérique mais également des moyennes à obtenir à partir des réponses à une interrogation par échelle de likert. En plus la macro doit pouvoir concaténer du texte qui est soumis en réponse Pas simple mon explication! vous avez raison! Explication :
On part d'un fichier de données qui comporte plusieurs évaluations pour un même lieu de stage et il y a différents lieux de stage. Les données sont soit numériques, soit du texte ou encore une échelle de likert (dernière colonne). La répartition et la proportion de colonnes en textes ou en chiffres ou en échelle de likert n'est pas connue et variable de même que le nombre de lignes et le nombre de lieux de stage. Au final, on voudrait par lieu de stage, les moyennes sur les colonnes chiffrées, la concaténation des réponses en texte pour chaque lieu de stage et la moyenne des différentes réponses en échelle de likert pour chaque lieu de stage.
Je ne sais pas si cela faciliterait le travail mais j'ai nommé les différentes colonnes en commençant par N si ce sont des données numériques, T pour texte et L pour likert.
J' ai soumis à l'un d'entre vous mon problème. Les données sont dans l'onglet Feuil2. Le résultat de son travail de programmation est dans l'onglet restitution jusqu'aux colonnesAR. Le code VBA est dans le module 2. J'ai remarqué qu'il y a des valeurs numériques qui apparaissent dans les colonnes de textes concaténées en G et AN (Si cela peut être corrigé ce serait mieux). Tout le reste est correct sauf une difficulté sur les moyennes de valeurs obtenues par réponses à une échelle de likert. Les données Likert sont dans la colonne AR. Ce que je souhaite en plus, si c'est possible, c'est que la macro me fasse automatiquement les moyennes sur chacune des réponses pour chaque lieu de stage. J'ai fait les calculs manuellement avec NB.SI et les ai présenté sur l'onglet restitution en colonnes AS à AV pour vous montrer le résultat attendu.
Nb ; Information sur échelle de Likert : On utilise beaucoup cela pour obtenir des indices de satisfaction d'une action menée ou pour mesurer une adhésion à une idée, un concept. Une fois que les participants ont répondu, on fait des moyennes sur ceux qui ont répondu très satisfait, moyennement satisfait, pas du tout satisfait . Les terms d'une échelle de likert sont propre à chaque projet de recherche. Dans les études de consensus, on cote de 0 à 10 et on fait des moyennes pour sur chacune des notes pour savoir combien ont répondu 0, 1,...9,10. Pour calculer ces moyennes, on pourrait positionner l'echelle de Likert avec ses critères sur un autre onglet pour faciliter , peut-être, votre programmation.
Bon l'explication est fort longue mais la demande complexe bien que partiellement déjà résolue. J'espère que vous avez compris. Il ne s'agit pas de simples moyennes (enfin c'est ce que je trouve avec mes yeux de profane en VBA).
Merci de ce que vous pourrez faire comme miracle informatique
Cordialement
Bonjour,
qui n'existe pas !Le code VBA est dans le module 2.
sauf une difficulté sur les moyennes de valeurs obtenues par réponses à une échelle de likert. Les données Likert sont dans la colonne AR. Ce que je souhaite en plus, si c'est possible, c'est que la macro me fasse automatiquement les moyennes sur chacune des réponses pour chaque lieu de stage.
ok, donc on peut cibler la réponse sur un extrait ne contenant que la cotation sur l'échelle de Likert.
Généralement on donne un résultat en barre colorée avec une valeur dépendant de ce que l'on veut afficher
Par exemple, pour ici et l'ensemble des établissements hospitaliers :
| Je suis très satisfait | 19% |
| Je suis très satisfait + Satisfaction moyenne | 42% |
| Pas satisfait | 28% |
| Pas satisfait + Pas très satisfait | 58% |
Ceci s'obtient simplement par un TCD et pas forcément par une macro. Mais on peut l'inclure dans le calcul ... si tu veux une et une seule valeur il faut choisir entre les 4.
Bonjour Steelson, pbpb76
En Feuil2, colonne AS, si j'ai bien compris, c'est ce genre de formule que vous souhaitez.
=NB.SI.ENS($A$2:$A$192;$A2;$AR$2:$AR$192;$AR2)/NB.SI($A$2:$A$192;$A2)En AS2, à recopier vers le bas : format pourcentage
klin89
re pbpb76,
Essayez ceci :
En Feuil2, , ajoutez au préalable une colonne supplémentaire en bout de tableau (P_44) et recopier la formule comme indiqué ci-dessus.
=NB.SI.ENS($A$2:$A$192;$A2;$AR$2:$AR$192;$AR2)/NB.SI($A$2:$A$192;$A2)
Le code :
Option Explicit
Sub test1()
Dim a, b(), w(), i As Long, j As Long, n As Long, dico As Object, e
Set dico = CreateObject("Scripting.Dictionary")
dico.comparemode = 1
'feuille source
With Sheets("Feuil2").Cells(1).CurrentRegion
a = .Value: n = 1
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
b(n, 1) = a(1, 1): b(n, 2) = "Nbre"
For j = 2 To UBound(a, 2) - 1
b(n, j + 1) = a(1, j)
Next
For i = 2 To UBound(a, 1)
If Not dico.exists(a(i, 1)) Then
ReDim w(1 To 2)
Set w(1) = CreateObject("Scripting.Dictionary")
w(1).comparemode = 1
n = n + 1: w(2) = n
b(w(2), 1) = a(i, 1)
Else
w = dico.Item(a(i, 1))
End If
b(w(2), 2) = b(w(2), 2) + 1
For j = 2 To UBound(a, 2) - 1
Select Case True
Case a(1, j) Like "N*"
b(w(2), j + 1) = b(w(2), j + 1) + a(i, j)
Case a(1, j) Like "T*"
If Not IsEmpty(a(i, j)) Then
If IsEmpty(b(w(2), j + 1)) Then
b(w(2), j + 1) = a(i, j)
Else
b(w(2), j + 1) = b(w(2), j + 1) & vbLf & a(i, j)
End If
End If
Case a(1, j) Like "L*"
If Not w(1).exists(a(i, j)) Then
w(1)(a(i, j)) = Empty
b(w(2), j + 1) = IIf(IsEmpty(b(w(2), j + 1)), a(i, j) & " " & Format(a(i, j + 1), "0.0%"), _
b(w(2), j + 1) & vbLf & a(i, j) & " " & Format(a(i, j + 1), "0.0%"))
End If
Case Else
End Select
Next
dico.Item(a(i, 1)) = w
Next
For Each e In dico.keys
For j = 3 To UBound(b, 2)
If b(1, j) Like "N*" Then
b(dico.Item(e)(2), j) = b(dico.Item(e)(2), j) / b(dico.Item(e)(2), 2)
End If
Next
Next
End With
'Restitution
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets("restitution1").Delete
Sheets.Add().Name = "restitution1"
On Error GoTo 0
With Sheets("restitution1").Cells(1)
With .Resize(n, UBound(b, 2))
.Value = b
.Font.Name = "calibri"
.Font.Size = 10
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.VerticalAlignment = xlCenter
With .Rows(1)
.BorderAround Weight:=xlThin
.Interior.Color = 4697456
.HorizontalAlignment = xlCenter
End With
'.Columns.AutoFit
With .Offset(, 2).Resize(, .Columns.Count - 2)
.Columns.NumberFormat = "0.00"
End With
End With
.Parent.Activate
End With
Set dico = Nothing
Application.ScreenUpdating = True
End Subklin89
re pbpb76,
Essayez cette nouvelle version :
Pas besoin d'ajouter une colonne supplémentaire dans la feuille source comme indiqué précédemment.
Option Explicit
Sub test1()
Dim a, b, w(), e, s, p, arr, i As Long, j As Long, n As Long, ub As Byte, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.comparemode = 1
'feuille source
With Sheets("Feuil2").Cells(1).CurrentRegion
a = .Value: n = 1
arr = Array("Je suis très satisfait", "Satisfaction moyenne", "Pas très satisfait", "Pas satisfait")
ub = UBound(arr)
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2) + ub + 1)
b(n, 1) = a(1, 1): b(n, 2) = "Nbre"
For j = 2 To UBound(a, 2) - 1: b(n, j + 1) = a(1, j): Next
For j = LBound(arr) To UBound(arr): b(n, UBound(b, 2) - ub + j) = arr(j): Next
For i = 2 To UBound(a, 1)
If Not dico.exists(a(i, 1)) Then
ReDim w(1 To 2)
Set w(1) = CreateObject("Scripting.Dictionary")
w(1).comparemode = 1
n = n + 1: w(2) = n
b(w(2), 1) = a(i, 1)
Else
w = dico.Item(a(i, 1))
End If
b(w(2), 2) = b(w(2), 2) + 1
For j = 2 To UBound(a, 2)
Select Case True
Case a(1, j) Like "N*"
b(w(2), j + 1) = b(w(2), j + 1) + a(i, j)
Case a(1, j) Like "T*"
If Not IsEmpty(a(i, j)) Then
If IsEmpty(b(w(2), j + 1)) Then
b(w(2), j + 1) = a(i, j)
Else
b(w(2), j + 1) = b(w(2), j + 1) & vbLf & a(i, j)
End If
End If
Case a(1, j) Like "L*"
w(1)(a(i, j)) = w(1)(a(i, j)) + 1
Case Else
End Select
Next
dico.Item(a(i, 1)) = w
Next
For Each e In dico.keys
For j = 3 To UBound(b, 2) - ub - 1
If b(1, j) Like "N*" Then
b(dico.Item(e)(2), j) = b(dico.Item(e)(2), j) / b(dico.Item(e)(2), 2)
End If
Next
For Each s In dico.Item(e)(1)
p = Application.Match(s, arr, 0)
If Not IsError(p) Then
b(dico.Item(e)(2), UBound(b, 2) - ub + p - 1) = dico.Item(e)(1)(s) / b(dico.Item(e)(2), 2)
End If
Next
Next
End With
'Restitution
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets("restitution2").Delete
Sheets.Add().Name = "restitution2"
On Error GoTo 0
With Sheets("restitution2").Cells(1)
With .Resize(n, UBound(b, 2))
.Value = b
.Font.Name = "calibri"
.Font.Size = 10
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.VerticalAlignment = xlCenter
With .Rows(1)
.BorderAround Weight:=xlThin
.Interior.Color = 4697456
.HorizontalAlignment = xlCenter
End With
With .Offset(, UBound(b, 2) - ub - 1).Resize(, ub + 1)
.Rows(1).Interior.Color = 52428
On Error Resume Next
.SpecialCells(4).Value = 0
On Error GoTo 0
.Columns.NumberFormat = "0.0 %"
End With
With .Offset(, 2).Resize(, UBound(b, 2) - ub - 3)
.Columns.NumberFormat = "0.00"
End With
.Columns.AutoFit
End With
.Parent.Activate
End With
Set dico = Nothing
Application.ScreenUpdating = True
End SubIllustration du tableau final restitué :
klin89
Bonjour Klin,
c'est bien d'être persévérant
mais pbpb76 n'a pas fait d'apparition depuis le 05 mai 2020, 22:48
pas de retour, pas de critique, pas de remerciements ... espérons que cela serve quand même à lui et d'autres !
2 solutions, une avec TCD et une en VBA
Bonjour Steelson,
Ne t'inquiète pas, elle va revenir, je pense qu'elle a beaucoup de travail et n'est peut-être pas très disponible en ce moment
klin89