Astuces Excel
  1. Astuces Excel
  3. Existe-t-il une fonction VBA ou une formule pour regrouper les résultats par numéro d'identification?
Intereting Posts
Améliorez la taille du graphique lorsque vous êtes déplacé La reference relative Excel dans INDEX ne se déplace pas après la ligne d'insertion En utilisant Excel VBA, comment puis-je garder mon code d'origine s'exécuter après un événement 'thisworkbook.close' dans un 2ème classur? Trier une colonne dans Excel par rapport à une autre Erreur d'exécution VBA 91 sur la deuxième itération Comstack Error: Next sans FOR Filtrage de chaque ws par mois Mettre à jour la feuille Excel à partir de la database en C # utilisez OpenOffice Calc pour ouvrir des files Excel et convertir en CSV ou Tab-délimité vérifier les valeurs Comment append de l'espace entre les lignes et résumer automatiquement dans Excel Les fonctions Cast et Convert ne sont pas sockets en charge lors de la conversion du format de la date de la colonne à la date (dans vbscript – Excel adodb) La macro à partir de Word ne fonctionne pas dans Excel peut-elle être modifiée pour Excel? Insérer des données à partir d'une feuille de calcul Excel dans Microsoft Access en utilisant C # ne fonctionne pas pour des champs spécifiques La fonction Excel VBA s'effondre si les variables ont été déclarées Générer un file tableur sur iOS lisible à la fois par Excel et les numéros

Existe-t-il une fonction VBA ou une formule pour regrouper les résultats par numéro d'identification?

sheet2 a: 

123, thomas 123, gordon 123, smith 334, joey 334, nancy 3452, angela 3452, liza

Le résultat que je veux est: 

 123, thomas, gordon, smith 334, joey, nancy 3452, angela, liza

Existe-t-il un moyen simple de le faire avec une formule? Sinon, comment puis-je le faire avec VBA?

Voici une petite fonction VBA (réglage précis) 

 Function GetCSV(r As Range, v As Integer) As Ssortingng Dim i As Long, j As Long Dim s As Ssortingng For i = 1 To r.Rows.Count If r.Cells(i, 1) = v Then s = s & ", " & r.Cells(i, 2) End If Next i GetCSV = v & s End Function

Exemple d'utilisation (en supposant que A1: B14 est votre gamme de données) 

 =GetCSV(A1:B14,A1)

Collez votre exemple de colonne de départ dans la plage ("A1"), collez le code ci-dessous dans un module et exécutez. Je vais à la maison, à vous de faire le formatting et de vérifier si vous l'aimez ou pas! 

 Sub Test() Dim rRange As Range Dim iRange As Integer Dim rRange_Final As Range Dim sSsortingng As Ssortingng Dim iPosition As Integer Dim sID As Integer Dim sName As Ssortingng Dim sCheck As Ssortingng Dim iCnt As Integer Dim iCntB As Integer Dim iCntC As Integer Dim iCntD As Integer Dim vArray() As Variant Dim vArray_Dest() As Variant Dim vArray_Final() As Variant Dim bCheck As Boolean Application.ScreenUpdating = False 'Set range dynamically and load data into an array Set rRange = ThisWorkbook.Sheets(1).Range(Cells(1, 1), Cells(1, 1).End(xlDown)) iRange = rRange.Rows.Count ReDim vArray(1 To iRange) ReDim vArray_Dest(1 To iRange, 1 To 3) vArray = rRange 'Split based on comma and load into a two dimensional array For iCnt = 1 To iRange sSsortingng = Trim(vArray(iCnt, 1)) iPosition = InStr(1, sSsortingng, ",") + 1 sID = Trim(Left(sSsortingng, Len(sSsortingng) - (Len(sSsortingng) - iPosition))) sName = Trim(Mid(sSsortingng, iPosition, Len(sSsortingng) - iPosition)) vArray_Dest(iCnt, 1) = sID vArray_Dest(iCnt, 2) = sName Next iCnt iCnt = 0 iCntC = 0 'Loop through the newly created array, assign ID For iCnt = 1 To iRange sCheck = vArray_Dest(iCnt, 1) If vArray_Dest(iCnt, 3) = Empty Then iCntC = iCntC + 1 ReDim Preserve vArray_Final(1 To iCntC) For iCntB = 1 To iRange If sCheck = vArray_Dest(iCntB, 1) Then vArray_Dest(iCntB, 3) = iCntC End If Next iCntB End If Next iCnt 'Loop through the array while building ssortingng in separate array iCnt = 0 iCntB = 0 For iCnt = 1 To iCntC bCheck = False For iCntB = 1 To iRange If vArray_Dest(iCntB, 3) = iCnt And bCheck = False Then vArray_Final(iCnt) = vArray_Dest(iCntB, 1) & ", " & vArray_Dest(iCntB, 2) bCheck = True ElseIf vArray_Dest(iCntB, 3) = iCnt And bCheck = True Then vArray_Final(iCnt) = vArray_Final(iCnt) & ", " & vArray_Dest(iCntB, 2) End If Next iCntB Next iCnt iCnt = 0 'Fill in range For iCnt = 1 To iCntC ThisWorkbook.Sheets(1).Cells(iCnt, 3).Value = vArray_Final(iCnt) Next iCnt End Sub