Astuces Excel
  1. Astuces Excel
  3. Rassembler une trousse à une seule dimension sans boucler
Intereting Posts
Comment créer un tableau en utilisant sql / VBA dans excel avec ADO Superscript de la table R vers Excel? Excel VBA TextStream.writeline avec caractères chinois Excel 2013 – binding XML VBA rompue lors du redémarrage Valeurs de sum dans une colonne en fonction de la date Autorun Excel avec script VBA et insertion automatique d'un file basé sur un masque de date Créer un file Excel à partir d'un schéma XML complexe VBA – Ouvrez un UserForm en cliquant n'importe où dans une colonne spécifique PHPExcel – Comment appliquer des bordures à la plage dynamic de cellules chargées à partir de données mysql PHPExcel – Pourquoi SetTitle prend tellement de time Coller dans le courrier Outlook avec un format de corps spécifique via Excel Définir la configuration Excel pour l'application Interop C # Cellule de return des cellules correspondantes dans une autre feuille Ajouter un module existant à une feuille de calcul dans Excel Comment puis-je calculer le CDF de la dissortingbution chi-carré dans Excel?

Rassembler une trousse à une seule dimension sans boucler

La ligne de code suivante alloue un tableau en une seule dimension, sortedArr = WorksheetFunction.Transpose(lstIssues1.List) . Cette ligne de code atsortingbue un tableau en tant arrIssues = Table.ListColumns(Table.ListColumns(strNumber).Range.column).DataBodyRange bidimensionnelle arrIssues = Table.ListColumns(Table.ListColumns(strNumber).Range.column).DataBodyRange

Pour chacune des lignes ci-dessus, j'appelle une fonction de sorting des bulles. Mais il s'agit d'erreurs sur l'un ou l'autre selon que je pose 

 If Arr(i) > Arr(j) Then ...

Ou 

 If Arr(i, 1) > Arr(j, 1) Then ...

Je peux boucler pour remplir les arrIssues . Mais je me request s'il est possible de le remplir comme un réseau unidimensionnel sans boucle.

METTRE À JOUR

Voici le code avec lequel je suis en difficulté 

 Private Sub cmdRemove_Click() Dim SortedArr() As Variant With lstPrevious If .ListIndex = -1 Then Exit Sub For i = .ListCount - 1 To 0 Step -1 If .Selected(i) = True Then lstAdditional.AddItem .List(i) .RemoveItem (i) End If Next i End With ReDim SortedArr(lstAdditional.ListCount - 1) SortedArr = Application.Transpose(lstAdditional.List) 'ERROR Type Mismatch Call BubbleSort(SortedArr) Me.lstAdditional.List = SortedArr txtFocus.SetFocus End Sub Public Sub BubbleSort(Arr) Dim strTemp As Ssortingng Dim lngMin As Long Dim lngMax As Long lngMin = LBound(Arr) lngMax = UBound(Arr) For i = lngMin To lngMax For j = i + 1 To lngMax If Arr(i) > Arr(j) Then strTemp = Arr(i) Arr(i) = Arr(j) Arr(j) = strTemp End If Next j Next i End Sub

Curieusement, j'utilise la même logique dans une autre forme d'user et ça marche. Désolé pour le manque de clarté.

Pour chacune des lignes ci-dessus, j'appelle une fonction de sorting des bulles. Mais les erreurs sur l'une ou l'autre selon que je pose If Arr (i)> Arr (j) puis … Ou Si Arr (i, 1)> Arr (j, 1) Ensuite …

Vos valeurs de i , j sont incorrectes et donc des erreurs. Je suppose que vous obtenez Subscript out of range error .

Voici un moyen simple de reproduire l'erreur que vous obtenez. 

 Sub Sample() Dim i As Long, j As Long, k As Integer Dim MyAr As Variant MyAr = Range("A1:A5").Value For i = LBound(MyAr) To UBound(MyAr) For j = LBound(MyAr) To UBound(MyAr) If MyAr(j, 1) > MyAr(j + 1, 1) Then k = MyAr(j, 1) MyAr(j, 1) = MyAr(j + 1, 1) MyAr(j + 1, 1) = k End If Next Next End Sub

La manière correcte consiste à boucler jusqu'à UBound(MyAr) - 1 

 Sub Sample() Dim i As Long, j As Long, k As Integer Dim MyAr As Variant MyAr = Range("A1:A5").Value For i = LBound(MyAr) To (UBound(MyAr) - 1) For j = LBound(MyAr) To (UBound(MyAr) - 1) If MyAr(j, 1) > MyAr(j + 1, 1) Then k = MyAr(j, 1) MyAr(j, 1) = MyAr(j + 1, 1) MyAr(j + 1, 1) = k End If Next Next End Sub