Formules en VBA pour tableau structuré

Question

Bonjour; dans les trois premières colonnes de la feuille 'dexp' j'ai decortiqué à la lumière des définition des codes en feuille 'param' le code qui est en colonne Tag de la feuille data, comme mon vrai fichier comporte des milliers de lignes je galère pour copier en glissant les formules; je cherche alors à faire ces formules en vba exemple pour le site: si le code est en 14 caractère alors soustraire le nom du site comme ceci (parfois le code est 15 caractère comme c le cas des dernières lignes) =SIERREUR(SI(NBCAR(TAB_DATAfx&#91;@Tag&#93;)=14;INDEX(TAB_ville_site;EQUIV(STXT(TAB_DATAfx&#91;Tag&#93;;1;9);TAB_ville_site&#91;VILLE.SIT_C&#93;;0);3);INDEX(TAB_ville_site;EQUIV(STXT(TAB_DATAfx&#91;Tag&#93;;1;10);TAB_ville_site&#91;VILLE.SIT_C&#93;;0);3));"") comment faire ça en vba?? merci d'avance...

Jean-Eric · Accepted Answer

...

BsAlv · Accepted Answer

Re, nouvelle version les dates (et currency/monnaie) se lisent mieux avec Value2. Il faut ajouter des colonnes avec Redim et "preserve". On peut aussi assigner un tableau par une cellule de ce tableau Sub Kamel() Dim LO, cVille, cMes, cSite, aA, i, sp, s, sh, MyColumns, iCol, LO2 Set LO = Sheets("data").Range("A1").ListObject 'tableau de vos données = tableau avec cette cellule dans sa plage Set cVille = Sheets("param").ListObjects("TAB_Ville").DataBodyRange 'plage du tableau de vos villes Set cMes = Sheets("param").ListObjects("TAB_Mes").DataBodyRange 'plage du tableau de vos mesures Set cSite = Sheets("param").ListObjects("TAB_ville_site").DataBodyRange 'plage du tableau de vos sites aA = LO.Range.Value2 'lire vos données & entêtes complètement (avec dates ou currency toujours Value2 (!)) ReDim Preserve aA(1 To UBound(aA), 1 To UBound(aA, 2) + 3) 'ajouter 3 nouvelles colonnes vides, mais conserver le reste aA(1, UBound(aA, 2) - 2) = "Ville" 'première nouvelle colonne sera "ville" (entête) aA(1, UBound(aA, 2) - 1) = "Site" '2ième nouvelle colonne sera "Site" (entête) aA(1, UBound(aA, 2)) = "Mesure" 'dernière nouvelle colonne ser "Mesure" (entête) On Error Resume Next 'continuer en cas d'erreur, si par exemple, on ne trouve pas la ville, le site ou la mesure For i = 2 To UBound(aA) 'boucler vos données sans les entêtes sp = Split(aA(i, 1), ".") 'diviser sur le "." aA(i, UBound(aA, 2) - 2) = WorksheetFunction.VLookup(sp(0), cVille, 2, 0) 'rechercher la ville aA(i, UBound(aA, 2) - 1) = WorksheetFunction.VLookup(sp(0) & "." & sp(1), cSite, 3, 0) 'rechercher le site aA(i, UBound(aA, 2)) = Application.WorksheetFunction.VLookup(sp(2), cMes, 2, 0) 'rechercher la mesure If Err.Number &lt;&gt; 0 Then s = s & ", " & i: Err.Clear 'on sauvegarde toutes les lignes avec des erreurs Next On Error GoTo 0 Set sh = Sheets.Add(after:=Sheets(Sheets.Count)) 'ajouter une nouvelle feuille MyColumns = Array(2, 3, 5, 6, 7, 4) 'supposons(!) qu'on veut cette séquence de colonnes, pas la séquence originale With sh.Range("A1").Resize(UBound(aA), UBound(MyColumns) + 1) 'plage pour nos données avec autant de colonnes For iCol = 0 To UBound(MyColumns) .Offset(, iCol).Resize(, 1).Value = Application.Index(aA, 0, MyColumns(iCol)) Next .Columns(1).NumberFormat = "dd/mmm/yy" 'date .Columns(2).NumberFormat = "hh:mm:ss" 'heure .EntireColumn.AutoFit Set LO2 = .Parent.ListObjects.Add(Source:=.Offset(0)) 'c'est un tableau maintenant End With If Len(s) Then MsgBox Mid(s, 3), vbInformation, "lignes avec des erreurs" End Sub...

78chris · Accepted Answer

Pour que la poignée de recopie fonctionne il faut avoir une colonne déjà remplie à gauche ou à droite Dans ton cas : sélectionner la valeur ou la formule et la copier taper dans la zone de nom l'adresse de dernière cellule: A5000 par exemple utiliser CTRL flèche haut puis coller Pour 4 colonnes, on copie les 4 cellules et, entre l'étape 2 et 3, on sélectionne les 4 cellules de la ligne 5000...

Eric Kergresse · Answer

Vous positionner sur la cellule contenant la formule. Basculer dans l'éditeur VBA, faire apparaitre la fenêtre exécution avec Ctrl-G Dans la fenêtre exécution, taper la formule ?ActiveCell.Formula La formule va être traduite en VBA. Il restera à doubler les "", là où ils apparaissent...

BsAlv · Answer

Je propose ceci, cette macro met la ville, le site et la mesure dans une plage à côté de votre tableau (ou on pouvait aussi l'ajouter au tableau). Sub Kamel() Dim LO, cVille, cMes, cSite, aA, aOut, i, sp, x, s Set LO = Sheets("data").Range("A1").ListObject 'tableau de vos données Set cVille = Sheets("param").ListObjects("TAB_Ville").DataBodyRange 'plage du tableau de vos villes Set cMes = Sheets("param").ListObjects("TAB_Mes").DataBodyRange 'plage du tableau de vos mesures Set cSite = Sheets("param").ListObjects("TAB_ville_site").DataBodyRange 'plage du tableau de vos sites aA = LO.DataBodyRange.Columns(1).Value2 'lire 1ière colonne de vos données ReDim aOut(1 To UBound(aA), 1 To 3) 'preparer un tableau avec le même nombre de lignes et 3 colonnes On Error Resume Next For i = 1 To UBound(aA) 'boucler vos données sp = Split(aA(i, 1), ".") 'diviser sur le "." aOut(i, 1) = WorksheetFunction.VLookup(sp(0), cVille, 2, 0) 'rechercher la ville aOut(i, 2) = WorksheetFunction.VLookup(sp(0) & "." & sp(1), cSite, 3, 0) 'rechercher le site aOut(i, 3) = Application.WorksheetFunction.VLookup(sp(2), cMes, 2, 0) 'rechercher la mesure If Err.Number &lt;&gt; 0 Then s = s & ", " & i: Err.Clear Next On Error GoTo 0 LO.DataBodyRange.Offset(, 10).Resize(, 3).Value = aOut 'coller les résultats à côté du tableau initial If Len(s) Then MsgBox Mid(s, 3), vbInformation, "lignes avec des erreurs" End Sub...

78chris · Answer

Un double clic sur la poignée de recopie de la cellule suffit à recopier jusqu'en bas Inutile de coder pour cela ...

BsAlv · Answer

Re, si aA a 3 dimensions, oui Sub test() Dim aA(1 To 4, 2 To 5, 3 To 6) For i = 1 To 3 MsgBox LBound(aA, i) & " " & UBound(aA, i) 'lowerbound and upperbound Next End Sub ce 0 veut dire toutes les lignes (on peut aussi utiliser une sélection de lignes)...