VBA : Récupération de donnée
J'ai un programme de récupération de données, je possède un classeur de calcul avec 10 208 cases d'entrée. J'ai crée un code VBA pour remplir et obtenir des informations sur les cases d'entrée de mon classeur, comme le titre des colonnes, des lignes, tableaux duquel les cases sont issue ainsi que le titre des feuilles. Mais pour une raison j'ignore le code ne fonctionne que sur les 700 première variable.
Voici le code :
Sub remplissage1()
Dim finp As Double
Dim nb As Long, i As Double, j As Long, Finl As Long
Dim nb2 As Long
Dim x As Boolean
Dim y As Integer
Dim k As Long
Dim l As Double
Dim m As Long
Dim n As Long
Dim o As String
Dim tws, ws As Worksheet
tws = Array("Energie 1", "Energie 2", "Hors énergie 1", "Hors énergie 2", "Intrants 1", "Intrants 2", "Futurs emballages", "Déchets directs", "Fret", "Déplacements", "Immobilisations", "Utilisation", "Fin de vie", "Utilitaires") ' De Energie1 à fin de vie
nb2 = 1 'Conteur Data
j = 1 'conteur de colone
i = 1 'conteur de ligne
finp = 700 ' profondeur/ligne
Finl = 43 'longueur/colonne
nb = j
For Each ws In Worksheets(tws)
ws.Select 'Feuille Selectionné
o = ws.Name
Do While i <= finp
For j = nb To Finl Step 1
x = False: On Error Resume Next 'conteur de choix multiple
x = Cells(i, j).Validation.InCellDropdown 'conteur de choix multiple
y = IIf(x = True, 11111, 0) 'conteur de choix multiple
'ws.Select 'Debut de la selection
Cells(i, j).Select
If Not y = 11111 And Not Left(Cells(i, j).Formula, 1) = "=" And Not Cells(i, j).MergeCells And IsNumeric(Cells(i, j)) And Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous And Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous And Selection.Borders(xlEdgeTop).LineStyle = xlContinuous And Selection.Borders(xlEdgeRight).LineStyle = xlContinuous Then
nb2 = nb2 + 1
Sheets("test").Cells(2, nb2) = ws.Cells(i, j)
Sheets("test").Cells(3, nb2) = i
Sheets("test").Cells(4, nb2) = j
ws.Cells(i, j) = Sheets("test").Cells(1, nb2)
Sheets("test").Cells(10, nb2).Value = o ' récupération titre page
Sheets("test").Cells(10, nb2).Value = ws.Name ' récupération titre page
' incrementation conteur de variable d'entrée
l = 1
k = 1
Do While l = 1 'Récupération du titre de la colonne
If Not i = k And i > 1 Then
'Cells(i - k, j).Select
If WorksheetFunction.IsText(Cells(i - k, j)) And Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous And Selection.Borders(xlEdgeRight).LineStyle = xlContinuous And Selection.Borders(xlEdgeTop).LineStyle = xlContinuous Then
Sheets("test").Cells(5, nb2) = ws.Cells(i - k, j) ' Bordure sup
l = 0
ElseIf WorksheetFunction.IsText(Cells(i - k, j)) And Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous And Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous And Selection.Borders(xlEdgeRight).LineStyle = xlContinuous And Selection.Borders(xlEdgeTop).LineStyle = xlContinuous And Not i = k Then
Sheets("test").Cells(5, nb2) = ws.Cells(i - k, j) 'contoure
l = 0
ElseIf WorksheetFunction.IsText(Cells(i - k, j)) And Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous And Selection.Borders(xlEdgeRight).LineStyle = xlContinuous Then
Sheets("test").Cells(6, nb2) = ws.Cells(i - k, j) 'bordure inf
k = k + 1
Else
k = k + 1
'MsgBox k
End If
Else
l = 0
End If
Loop
Sheets("test").Cells(7, nb2) = ws.Cells(i, 2) 'Récupération du titre de ligne
l = 1
n = 1
Do While l = 1 'Récupération du titre de tableau
' ws.Cells(i - n, 2).Select
If WorksheetFunction.IsText(Cells(i - n, 2)) And Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous And Selection.Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(i - n - 1, 2) = "" Then
Sheets("test").Cells(8, nb2) = ws.Cells(i - n, 2)
l = 0
Else
n = n + 1
End If
Loop
l = 1
m = 1
Do While l = 1 'Récupération du titre de la catégorie
If Not i = m And i > 1 Then
'Cells(i - m, j).Select
If Cells(i - m, j).MergeCells And Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous And Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous And Selection.Borders(xlEdgeRight).LineStyle = xlContinuous And Selection.Borders(xlEdgeTop).LineStyle = xlContinuous And Not i = m And Cells(i - m + 1, j) = "" And Cells(i - m - 1, j) = "" Then
Selection.Copy
Sheets("test").Select
Cells(9, nb2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.UnMerge
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = False
l = 0
Else
m = m + 1
'MsgBox k
End If
Else
l = 0
End If
Loop
End If
Next
i = i + 1
Loop
'MsgBox i
'MsgBox j
'
Next ws
'Cells(i, j).Select
End SubHello,
as-tu essayer de remplacer la valeur de la variable finp ?
A mon avis en un bref coup d’oeil c’est celle-ci qui dirige le nombre de ligne.
A+,
Kilian
Alors j'ai changer le type de finp par Long mais ça ne change rien. Deplus, j'ai remarqué que seul la page Energie 1 est traité et je ne comprend pas pourquoi.
Déjà, Bonjour ! Et un petit svp ou merci ne fait pas de mal
Est-ce que tu as changer la valeur de finp ? Qui actuellement est égale à 700, si tu l'a met à 10'000 ?
Je n'ai pas de fichier donc pas de test possible.
A+,
Kilian
Excuse moi, sur internet j'oublie des fois mes manières, alors salut :)
mon fichier est trop lourd pour être télécharger mais si tu as un mail .
Cordialement.
As-tu essayer ?
De Kilian1906 :
Est-ce que tu as changer la valeur de finp ? Qui actuellement est égale à 700, si tu l'a met à 10'000 ?
Non désoler je ne prend pas de fichier par mail, arrive-tu a en faire un simplifier comme exemple ?
A+,
Kilian
Re
Alors voici un version alléger du fichier, le code est dans le module 2 et je vais testé avec 10 000 puis je te fais un retour.
A+
Bonjour à tous,
Suite à une sollicitation de LaventureEstivene en privé, je poste le code (version simplifiée de celui du sujet) ici :
Sub remptest()
Dim ws As Worksheet, tws, i&, j&, n&
tws = Array("Energie 1", "Energie 2", "Hors énergie 1", "Hors énergie 2", "Intrants 1", "Intrants 2", "Futurs emballages", _
"Déchets directs", "Fret", "Déplacements", "Immobilisations", "Utilisation", "Fin de vie", "Utilitaires") ' De Energie1 à fin de vie
If FeuillesInexistantes(tws) <> "" Then Exit Sub
For Each ws In Worksheets(tws)
For i = 1 To 700
For j = 1 To 43 '<<< A VOIR ?
With ws.Cells(i, j)
If Not HasValidateList(.Cells) And Not .HasFormula And Not .MergeCells And IsNumeric(.Value) And .Borders.LineStyle = 1 Then
n = n + 1
Sheets("test").Cells(10, n).Value = ws.Name
End If
End With
Next j
Next i
Next ws
End Sub
Function HasValidateList(cell As Range) As Boolean
On Error Resume Next
HasValidateList = cell.Validation.Type = xlValidateList
End Function
Function FeuillesInexistantes(t) As String
Dim temp()
For Each e In t
On Error Resume Next
If Sheets(e).Index = 0 Then
n = n + 1
ReDim Preserve temp(1 To n)
temp(n) = e
End If
Next e
If n > 0 Then FeuillesInexistantes = "Feuilles introuvables : " & vbLf & vbLf & Join(temp, " - "): MsgBox FeuillesInexistantes
End Functionla variable i n'est pas réinitialisée dans la boucle sur ws, ce qui implique qu'on ne rentre qu'une fois dans la boucle do while.
Cdlt,
cordialement.
Salut
Comme dit à 3GB en MP le code bug, des valeur attribué à une page se retrouve sur une autre: la ligne 3 revoie aux lignes et la ligne 4 aux colonnes
Au début, je pensais à un problème de variable alors j'ai initialiser n mais cela n'a rien changer et voici une version simplifier du classeur traiter avec mon code vba à l'intérieur.
Hello,
3GB es-tu dessus ?
Je n'aurai pas beaucoup de temps ces prochains jours pour regarder ceci.
A+
Kilian
Bonjour à tous,
@Kilian : Je suis le sujet et suis intervenu ici pour rendre publique ma contribution en privée (que tu sois informé au moins).
Mais comme LaventureEstivene ne veut pas simplement tester les codes tels qu'ils sont proposés, je ne m'impliquerai pas forcément à outrance.
@Laventure : Si tu veux bien, je préfère que les échanges se poursuivent ici plutôt qu'en privé. Ca laissera la porte ouverte à tout le monde.
Sinon, pour le bug, moi je vois que la feuille Test affiche bien les noms de feuille en ligne 10 (bien que l'utilité de la manoeuvre m'échappe pour le moment). Pour le reste, il ne s'agit pas de mon code... Ca doit être la 3è ou 4è fois que je fais la même remarque sur le fait de tester les codes des contributeurs, qui font l'effort de résoudre les problèmes. A chaque fois, tu reviens avec un nouveau code : Ce n'est pas comme ça que ça marche !
A chaque problème son sujet. Le mieux est de ne pas s'éparpiller car tu perds un temps fou à avancer.
Cdlt,
3GB mais de quoi tu parle j'ai tester la dernier version du code que tu m'as passer et ai fais un retour Lundi
Je parle de ton "bug" sur mon code. Mon code ne fait rien d'autre que reporter les noms de feuille en ligne 10 de la feuille Test lorsque les conditions sont réunies pour une cellule de la plage A1:AQ700 pour chacune des feuilles listées dans tws.
Sinon, je parle de ça :
Sub fore()
Dim l As Long
Dim m As Long
Dim n As Long
l = 1
m = 7
n = 1
Sheets("test").Select
For l = 1 To m Step 1
If Cells(14, l) = "" Then
Cells(14, l) = l
Else
l = m
End If
Next
For n = 1 To m Step 1
If Cells(15, n) = "" Then
Cells(15, n) = n
n = n + 1
Else
n = m
End If
Next
End Subou encore de ça : https://forum.excel-pratique.com/excel/identifier-les-listes-deroulante-157735
et de ça : https://forum.excel-pratique.com/excel/erreur-d-execution-1004-a-repetition-157796
Voilà
Salutation
Oui et alors ? J'ai le droit d'avoir des problèmes et pas de poser des questions ? C'est quoi ce flicage ? De plus, je te l'ai dit en privée et sur ces postes, je ne suis pas un expert en VBA et pourtant je dois justifier de chacune des lignes présentes don mon code final, alors excuse moi si je privilégié ce que je comprend à des codes alambiqué et de ne pas me reposé sur un seul poste ou commentaire pour faire mon travail. Car, oui je travail, je ne m'amuse pas et encore moins avec du VBA.
Je ne fais pas la charité, je cherche à comprendre donc si ça te fatigue de simplement prendre le temps de répondre à des questions et de ne pas avoir affaire à des soldat qui obéisse sans réfléchir, tu n'as qu'à m'ignorer, j'y survivrais !
Cordialement
Et alors, c'est énervant puisque tu fais perdre du temps à tout le monde. Si tu veux de l'aide, il faut jouer le jeu et essayer les contributions de chaque intervenant sans les modifier à ta sauce. Il ne faut pas démultiplier les codes et rester focaliser sur un problème.
Il ne faut pas solliciter les membres en privé alors même que tu as un sujet en cours. C'est un manque de respect envers ceux qui passent du temps à chercher à te venir en aide.
Tu ne poses pas de question, c'est ça le problème et je ne suis pas le dernier à donner des réponses quand on m'en demande.
Ce n'est absolument pas un flicage. Il s'agit juste des sujets que nous avons en commun que je te rappelle car tu semblais ne plus comprendre de quoi je parlais.
Ce sont tes codes qui sont alambiqués, je suis désolé. Je le répète, à aucun moment, tu ne m'as demandé la moindre explication. C'est bien de commenter un code mais c'est mieux de commenter un code qui marche, d'autant plus que tu as je ne sais combien de boucles, avec des conditions sur des formats de cellule...
Oui tu peux créer plusieurs sujets tant que ceux-ci traitent différents problèmes. Toi tu mélanges un peu tout j'ai l'impression. Je te conseille donc de créer un sujet pour comprendre le fonctionnement des boucles ou de créer tout ton code et de demander une amélioration ou des conseils mais pas de créer plusieurs sujets avec toujours le même code sans tenir compte des propositions précédemment apportées. Tu t'entêtes quoi...
Moi aussi je travaille, qu'est-ce que tu crois ? Et j'aide ici bénévolement. Et quand je suis confronté à des membres qui compliquent la résolution de leurs propres problèmes, ça ne m'amuse pas non plus comme tu peux le constater.
Tu as raison, je vais t'ignorer. C'est bien ce que je comptais faire avant que tu ne viennes me chercher en privé, je te rappelle. Lorsque tu chercheras vraiment à comprendre, tu y arriveras certainement.
Bonne continuation,
Depuis quand poser des questions est un manque de respect, je n'ai jamais caché avoir demander de l'aide en privée ou les résultats qui en ressorte mais oui je suis presser et je ne vais attendre des jour entier pour une simple réponse ! C'est quoi la prochaine étape, me reprocher de poser des questions sur un autre site ?
T'as balancé un code, ensuite c'était full reproche et tu viens me parler de contribution ! J'ai eu plusieurs problème avec mon code, de nature à chaque fois différente donc j'ai posé des questions en fonction et je ne vois toujours pas ou est le manque de respect la dedans. Quand au amélioration proposé lorsque qu'elle ne m'aide pas ou bug je le dis et bizarrement , je n'ai pas beaucoup de retour la dessus comme avec la dernier version de ton code qui bug et que j'ai signalé Lundi à 22H.
Au passage, je ne te remercie pas pour tout cette discutions sans intérêt!
Tu es pressé mais tu perds ton temps car tu ne tiens pas réellement compte des remarques qui te sont faites. Et tu fais perdre du temps aux membres car tu postes inlassablement le même code alors que des améliorations t'ont été proposées.
Tu manques de respect car tu ne considères pas le temps des autres et tu sabotes, sans l'avouer, le travail d'autrui. Comme tu viens de le dire, tu pourrais multiposter, ça ne te dérangerait pas... Mais tu n'es pas le centre du monde en fait et d'autres membres, plus enclins à l'écoute, avec des problèmes aussi importants que les tiens, ont besoin de solutions eux aussi et tu les en prives indirectement. Et ceux qui contribuent pourraient résoudre d'autres problèmes plutôt que passer du temps pour des causes perdues, qui s'entêtent.
Comme je t'ai dit, tu n'as posé aucune question. Je ne pense pas que mon code bug, bien que ce soit tout à fait possible. Mais en l'occurrence, rien dans mon code ne justifie des changements de valeurs aux lignes 3 et 4. C'est justement la raison de mon second emportement car je t'ai déjà fait le reproche. Tu ne testes pas correctement les codes, tu les remixes, tu fais n'importe quoi. Donc oui, tes codes ont des bugs et tu n'es pas plus avancé.
Maintenant, si tu es honnête, poste le code que tu as testé et qui produit tes résultats et tu verras qu'il n'est pas similaire en tous points au mien. Mais je ne crois pas que tu le sois car sinon, tu aurais manifesté ta difficulté à adapter mon code au lieu de faire comme s'il produisait des erreurs sans que tu ne l'aies modifié.
Enfin, je t'invite à relire nos échanges privés...
Excuse moi mais quand t'écris, tu entend de la musique dans ta tète ???
Oui je remixe les codes quand j'en ai besoin et je l'ai jamais caché alors je vois pas à quel moment tu viens parlé de mon honnête mais si tu te sens mal considéré demande une augmentation ou retourne voir tes parents et fou moi la paix car jusqu'à preuve du contraire , ici , t'as fais plus de morale que de la programmation !
Sérieux, faut être quel genre de kassos, pour parler de respect, de considération ou honnêté pour un commentaire ! Bien la solitude ?
Oui tu les remixes n'importe comment et regarde où tu en es. Mais tu affirmes ne jamais rien cacher, pourtant, tu ne dis pas clairement que tu les modifies et ça fait perdre du temps, en plus d'exaspérer. J'attends toujours que tu postes le code vu que tu agis apparemment en toute transparence et honnêteté.
Tu reviens toujours avec tes initialisations de tes 15 variables inutiles et tes step 1 inutiles. Tu es vraiment buté dans la bêtise ! En effet, je dois sûrement être le genre de kassos que tu viens solliciter en privé pour régler tes problèmes j'imagine