Astuces Excel
  1. Astuces Excel
  3. Code Excel VBA pour plusieurs vlookup
Intereting Posts
Comment empêcher la valeur XElement d'utiliser le formatting localisé? Tri personnalisé avec 3 touches Excel vba ne fonctionne pas lorsqu'il est exécuté à partir d'un file lorsqu'il est une pièce jointe Tableau pivot des returns maximaux Valeur nulle au lieu de la valeur réelle Pourquoi la méthode de la carte n'est-elle pas appelée mais les methods de configuration et de nettoyage sont appelées? Afficher la valeur la plus élevée après avoir combiné différentes colonnes l'installation bureautique MS bit 64 peut être returnnée à 32 sur Win 8.1 machine 64 bits Problème Excel XLSTART avec C # /. Net Un moyen correct de détecter une nouvelle forme dans un classur après avoir terminé une opération de collage Azure – Le fournisseur 'Microsoft.ACE.OleDb.12.0' n'est pas enregistré sur la machine locale Accédez à la valeur actuelle de Excel en cellule ciblée Comparaison automatisée du model de données et des arrays de database réels VBA – Modifier la colonne dans R1C1 Formule à partir du décalage de 1 à la décalage de 2 Exporter une feuille spécifique, et save différents files openpyxl Excel: comment résumer les cellules qui se trouvent à côté des cellules du même nombre

Code Excel VBA pour plusieurs vlookup

Pour un réseau de conduites, j'essaie de find les tuyaux qui s'écoulent dans un étang. Il peut y avoir plusieurs tuyaux qui peuvent s'écouler dans un seul trou d'homme. Ma structure de données est organisée de la manière suivante: 

Stop Node Label ....................... MH-37 CO-40 MH-37 CO-40 MH-39 CO-43 MH-37 CO-44 MH-39 CO-45 MH-41 CO-46 MH-35 CO-47 MH-44 CO-50 MH-39 CO-51 MH-44 CO-52

etc.

Bien sûr, dans Excel, nous pouvons vlookup question multiple de vlookup utilisant des équations de tableau. Cependant, je ne sais pas comment cela se fait dans le encoding Excel VBA. J'ai besoin d'automatiser l'set du process et donc le encoding Excel VBA. Cette tâche fait partie d'une tâche plus importante.

Voici le code de fonction que j'ai écrit jusqu'à présent: 

 Function Conduitt(M As Ssortingng) As Ssortingng() Dim Stop_Node As Variant /* All Manhole label */ Dim Conduit As Variant /* All conduit label */ Dim compare As Variant /* Query Manhole label */ Dim Result() As Ssortingng Dim countc As Integer Stop_Node = ActiveSheet.Range("B2:B73").Value Conduit = ActiveSheet.Range("C2:C73").Value compare = M countc = 1 Do While countc <= 72 If Application.IsError(Application.Match(Stop_Node(countc), compare)) = 0 Then Result(countc) = Conduit(countc) End If countc = countc + 1 Loop Conduitt = Result() End Function

Si vous comparez l'échantillon de données que j'ai fourni avant, pour Manhole MH-39 , les labels de conduit correspondantes sont, CO-43 , CO-45 et CO-51 . Je pensais, avec le changement de countc en raison de la boucle, il passera par la list et finda les correspondances exactes pour MH-39 et renvoyez CO-43 , CO-45 et CO-51 .

L'objective est de renvoyer ces labels de conduit uniquement sous la forme d'un réseau de strings avec trois lignes (pour le cas MH-39 ).

Jusqu'à présent, lorsque je lance le code, je reçois:

Erreur d'exécution '9': Abonnement hors limites.

J'ai cherché différents forums et j'ai trouvé qu'il se produit lorsque des éléments de tableau existants sont référencés. À ce stade, mes connaissances et mon expérience limitées ne consortingbuent pas à déchiffrer le casse-tête.

Après quelques suggestions de R3uK , le code a été corrigé. Apparemment, lorsqu'une gamme est atsortingbuée à une variante (comme dans le cas de Stop_Node et Conduit), la variante sera multidimensionnelle. Ainsi, a mis à jour le code en conséquence et a embedded Preserve with Redim.

Dans le cas où vous êtes intéressé, le code mis à jour: 

 Function Conduitt(Manhole As Ssortingng) As Ssortingng() Dim Stop_Node As Variant Dim Conduit As Variant Dim Result() As Ssortingng ReDim Result(0) Stop_Node = ActiveSheet.Range("B2:B73").Value Conduit = ActiveSheet.Range("C2:C73").Value For i = LBound(Stop_Node) To UBound(Stop_Node) If Stop_Node(i, 1) <> Manhole Then Else Result(UBound(Result)) = Conduit(i, 1) ReDim Preserve Result(UBound(Result) + 1) End If Next i ReDim Preserve Result(UBound(Result) - 1) Conduitt = Result

En fait, vous ne ReDim jamais votre Result() , ce n'est donc qu'un tableau vide sans cellule réelle (pas même une cellule vide), vous devez d'abord ReDim .

Voici ma version, je n'ai pas utilisé la fonction Match mais cela devrait fonctionner de toute façon: 

 Function Conduitt(ManHole As Ssortingng) As Ssortingng() Dim Stop_Node As Variant '/* All Manhole label */ Dim Conduit As Variant '/* All conduit label */ Dim Result() As Ssortingng ReDim Result(0) Stop_Node = ActiveSheet.Range("B2:B73").Value Conduit = ActiveSheet.Range("C2:C73").Value For i = LBound(Stop_Node) To UBound(Stop_Node) If Stop_Node(i,1) <> ManHole Then Else Result(UBound(Result)) = Stop_Node(i,1) ReDim Preserve Result(UBound(Result) + 1) End If Next i ReDim Preserve Result(UBound(Result) - 1) Conduitt = Result() End Function

Eh bien, voyez-vous résolu, mais voici une solution alternative (a dû publier maintenant que j'ai travaillé dessus) 

 Function ConduittCheck(manhole As Ssortingng) As Ssortingng() Dim result() As Ssortingng Dim manholeRange As Range Dim conduittRange As Range Set manholeRange = Range("manholes") Set conduittRange = Range("conduitts") Dim counter As Integer Dim size As Integer size = 0 For counter = 0 To manholeRange.Rows.Count If manholeRange.Rows.Cells(counter, 1) = manhole Then ReDim Preserve result(size) result(size) = conduittRange.Rows.Cells(counter, 1) size = size + 1 End If Next counter ConduittCheck = result() End Function