XL 2013 Boucle Index Equiv en VBA sur plusieurs Feuilles

r3dkross

XLDnaute Nouveau
Bonjour à tous, bonjour le forum,

Je reviens vers vous pour un petit coup de main en vba!

Je souhaite convertir une formule en vba car elle ralentit mon classeur entier, je réalise des imports jusqu’à 250000 lignes parfois. Voici la structure rapide de mon problème:

86C4B690-6C56-4808-A930-518C862D466F.jpeg


je souhaite remplir la colonne « commune à trouver » sur la feuille « data » à partir de la clé de recherche du même tableau en allant chercher dans la feuille « CléCommunes » la commune associée à la clé.
En cas d’erreur je recherche les 5 premiers caractères de la clé avec une fonction gauche.

tout fonctionne très bien en formule mais je n’arrive pas à le faire en vba, voici mon code:


VB:
sub recherchecommune ()
dim ws1, ws2 as worksheets
dim searchrng as range
set ws1 = sheets("Data")
set ws2 = sheets("CleCommunes")
set searchrng = ws1.range("B2:B75000")

for each c in searchrng

if isempty(c) then

c.value = worksheet.function.index(ws2.range("A2:A6220", worksheet.function.match(ws1.range("A2:A75000"), ws2.range("A2:A6220"),0))

end if

next

end sub

en sachant que j’utilise des tableaux nommés « Data » et « Cléscommunes » mais par contre je ne parviens pas à les utiliser.

PS: désolé je suis sur mobile je n’ai pas de fichier test je vous en envoie un des que possible!

merci beaucoup par avance pour votre aide!!

rk
 
Solution
Re


Test OK sur mon fichier exemple
VB:
Sub recherchecommune_bis()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim searchrng As Range, c As Range
Set ws1 = Sheets("Data"): Set ws2 = Sheets("Cle")
With Application
    .ScreenUpdating = False
    Set searchrng = ws1.Range("A2:A10")
    For Each c In searchrng
    If Not IsEmpty(c) Then
    c.Offset(, 1).Value = .Index(ws2.Range("B2:B10"), .Match(c, ws2.Range("A2:A10"), 0))
    End If
    Next
End With
End Sub
NB: Adapter les plages et le noms des feuilles selon les conditions réelles.
(Ici pour le test , j'ai utilisé A2:A10)

r3dkross

XLDnaute Nouveau
Je n’ai pas de quoi tester le code malheureusement mais de ce que j’en lis je vais boucler quasiment à l’infini sur chacune de mes cellules avec un message à chaque fois non?!
Sinon laisses moi la surprise lol je verrais ça lundi matin 😀
 

Staple1600

XLDnaute Barbatruc
Re

????
Il suffit de tester sur un classeur vierge.

Pour résumer (en reprenant la syntaxe de ton code )
Enrichi (BBcode):
Sub WhatTheFuck()
Dim shAry, sh
With ActiveWorkbook
    shAry = Array(.Sheets(1)) 
' ici le tableau (array) ne contient 
'qu'un seul élément: la feuille 1
End With
For Each sh In shAry
MsgBox sh.Cells(1).Parent.Name
Next
End Sub
Il est donc inutile de boucler.

C'est tout ce que voulait démontrer ce petit exemple du message#14

NB: Le code du message précédent se teste aussi sur un classeur vierge
Et, version bonus, il inclut le code VBA pour créer des données exemples
;)
 

r3dkross

XLDnaute Nouveau
Je suis sur mobile actuellement c’est pour ça que je n’ai pu le tester désolé! Preuve que j’ai encore beaucoup à apprendre c’est que je n’ai même pas réussi à décrypter cette subtilité!
Et à mon avis mon code complet est truffé de fautes du même genre!
 

Staple1600

XLDnaute Barbatruc
Re

Normalement, avec cette version de ta macro Import_Stock, on doit obtenir le même résultat.
VB:
Sub Import_Stock_bis()
Dim WS As Worksheet, wb2 As Workbook, a, vFile As Variant
Set WS = ActiveWorkbook.Worksheets("Data")
Application.ScreenUpdating = False
vFile = Application.GetOpenFilename("Fichier Excel,*.xlsx", 1, "Choisir le fichier à ouvrir", , False)
If TypeName(vFile) = "Boolean" Then Exit Sub
Set wb2 = Workbooks.Open(vFile)
WS.Cells.ClearContents
a = wb2.Sheets(1).UsedRange.Value2
WS.Cells(1).Resize(UBound(a, 1), UBound(a, 2)) = a
wb2.Close False
End Sub
NB: Et tu peux voir comment on obtient un copier/coller Valeurs seules sans passer par un copier/coller. ;)
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous, Staple1600 @,

Une version rapide sans dictionary donc compatible Apple (la pomme quoi)
  • On a pris pour hypothèse que les deux tableaux sont des tableaux structurés.
  • Dans le tableau structuré de la feuille "Data", l'emplacement des colonnes Clé et Commune sont recherchées par leur intitulé "clé" et "commune"
  • Dans le tableau structuré de la feuille "FullCle", l'emplacement des colonnes CLE et COMMUNE sont les deux premières colonnes
  • Le code est dans Module1.
 

Pièces jointes

  • r3dkross- recherche commune- v1.xlsm
    509.5 KB · Affichages: 19
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Très joli Body, bien Rangé, et qui fleure bon Datah
Très élégante et jolie dame aux atours absolument magnifiques (j'adore les motifs et couleurs de la robe).

On notera que dans la tenue des hommes, les très aériens, charmants et légers éventails de plumes de la femme ont été remplacés par un sabre d'airain, agressif et lourd ainsi qu'un un bouclier.
 
Dernière édition:

r3dkross

XLDnaute Nouveau
Bonjour à tous,
Déjà je suis navré de n'avoir répondu plus tôt et je tenais à vous remercier une fois de plus pour vos contributions!
=>Staple1600 j'ai pu intégrer ton code et effectivement un copier coller sans copier coller ça m'a surpris au départ mais c'est très efficace!

=>mapomme je tiens à m'excuser par avance car effectivement le tableau fullcle d'origine contient plus de colonnes (Code Insee, Communauté de communes etc... soit 10 au total)
J'ai donc voulu adapter ton code en modifiant simplement
VB:
 tcomm = .Range.Columns("b:c").Value

Mais malheureusement j'avoue ne pas avoir compris le code, surtout sur cette notion d'auxil. D'après ce que je lis il s'agit de déclarer une position de ligne grâce à cela et une fois la copie faite on supprime cette colonne auxil...
Arf pourtant je vois bien les recherches des colonnes clés, communes etc...
Je peux toujours changer mes colonnes de place pour utiliser le code pour la ville mais j'aimerais comprendre afin d'être autonome par la suite.

Désolé encore une fois d'avoir trop restreint mes données exemples.

Bien à vous.
 

Discussions similaires

Réponses
13
Affichages
849
Réponses
2
Affichages
536

Statistiques des forums

Discussions
311 710
Messages
2 081 781
Membres
101 817
dernier inscrit
carvajal