VBA sous Excel

Question

Bonjour,
s'il vous plait j'ai besoin d'aide je suis débutante en VBA sous excel meme si j'ai pu faire quelques programme je beug dans une petite boucle qui me permettra de terminer donc je vous explique:
j'ai un tableau par exemple de 7lignes et 7 colonnes
dans la première lignes la 2éme ainsi de suite par exemple j ai ces numéros:
Col1 Col2 Col3 Col4 Col5Col6 Col7 Col8
lig1: 0 0 1 15 16 47 78 59
lig2: 0 0 2 26 45 48 15 45
lig3: 12 0 0 0 0 </gras> 12 12 6
lig4: 2 5 0 0 0 </gras> 5 8 9
lig5: 12 2 0 0 0 </gras> 15 45 0
lig6: 26 45 48 10 8 56 0 0
lig7: x x x x x x 0 0
lig8: x x x x x x 0 0

comme vous voyez il y 'a une certaine symétrie le programme que je veux faire est un algo en vba qui puisse me parcours ce tableau et que a chaque fois k'il trouve cette symétrie en gras soit entre deux lignes ou 3lignes qu'il me la mette en gras et il me la remplissen une couleur mais j'y arrive pas il s'arrete pas quand il trouve une symétrie par binomes voila mon pogramme qui marche pas:
Sub trouve0()
Dim i As Integer
Dim j As Integer

For i = 2 To 36
For j = 2 To 36

If ThisWorkbook.Worksheets("Feuil4").Cells(i, j).Text = 0 And ThisWorkbook.Worksheets("Feuil4").Cells(i + 1, j).Text = 0 And ThisWorkbook.Worksheets("Feuil4").Cells(i + 1, j + 1).Text = 0 And ThisWorkbook.Worksheets("Feuil4").Cells(i, j + 1).Text = 0 Then

Cells(i, j).Select
Selection.Font.Bold = True
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

Cells(i + 1, j).Select
Selection.Font.Bold = True
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

Cells(i + 1, j + 1).Select
Selection.Font.Bold = True
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

Cells(i, j + 1).Select
Selection.Font.Bold = True
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If

Next j

Next i
End Sub
s'il vous plait au secours merci énormément de votre compréhension et votre gentillesse d'avance!

ccm81 · Answer

bonjour

ton pb demande quelques éclaircissements
Q1. seuls les "0" sont concernés par cette "symétrie"?
Q2. cette symétrie, elle est faite par rapport à quoi?
Q3. Il n'y a que des couples de "0" en gras ?
Q4. peux tu reformuler ton pb

si tu pouvais envoyer un extrait de ton fichier au format excel 2003 sur cjoint.com par exemple avec un tableau traité comme tu le souhaites et joindre le lien au prochain post.

bonne suite

taniafifi · Answer

Bonjour tout d'abord je voudrais te remercier énormement pour ta participation ca me fait énormément plaisir , je répond à tes questions:
Q1: oui il y'a que les zéros qui sont concernés
Q2: cette symétrie est faite par rapports au n° de la lignes et le n°de colonnes je doit avoir le zéro dans par exemple la lig2 et la col2 ansin que la ligne qui la sui la lig3 et la col3 la jaurai une symétrie de binomes mais on peu aussi trouver celle de trinome par exemple lig 1 et col1 lig2 et colon2 et lig3 et colo3 on aura une symétrie de 0.
Q3: oui il ya que les couples de 0 zéro en gras car c ske je veu ke mon algorithme me fait il me parcour les deux premiéres lignes et il essaye de me trouver les 4zéro ds deu colonnes successives et du lignes sucessives aussi 
Q4: je sais pas si j'ai trés bien expliquer mais bon je peux reformuler si vous voulez ?

merci écormement pour ton aidde c'est trés préscieux pour moi et pour ta compréhension.

ccm81 · Answer

re

Q4. n'y a t'il pas une erreur dans ton tableau post 1. est que ligne 3 et 4 le dernier "0" ne serait il pas en gras ? 
Q5. si oui,  tu chercherais à isoler des "carrés" de "0" ?

ccm81 · Answer

re
Q5. suite 
dont la diagonale serait sur la diagonale du tableau?

ccm81 · Answer

re

un essai correspondant à ce que j'ai compris

https://www.cjoint.com/?0FiiN5J1MtD 

bonne suite

taniafifi · Answer

coucou désolé pour le retard merci énormément,
Q4: enffet si c'est juste que il me la pas mis les 3 "0" le la colonne 3,4 et 5 sont en gras dans les lignes 3 4 et5
Q5: enffet t'as tout a fait compris c comme une diagonal dans le tableau 
merci beaucoup beaucoup
s'il te plait je sais pas comment lire ce ke tu m'as envoyé ??? (je sais je suis trop nul en ski conserne la programmation!lol!)
merci pour ta compréhension.

taniafifi · Answer

ah enffet pour l'ouvrir c'est bon merci énormemen pour ton aide c'est trop gentil

taniafifi · Answer

j'ai vu ce que tu as fait c'est génial mais est ce que c'est pas la peine d'utiliser une boucle?

ccm81 · Answer

re

je ne comprends pas bien ta dernière question
est ce que c'est pas la peine d'utiliser une boucle?
en fait il y a deux boucles imbriquées
l'idée c'est que à partir d'un 0 sur la diagonale, on examine les carrés de dimension, 2, 3, etc ... dont le coin haut-gauche est ce 0, d'où la deuxième boucle

RQ1. dans la procedure CommandButton1_Click, il y a une référence à "tablo"
en fait "tablo" correspond à la plage sur la feuille contenant ton tableau
RQ2. tu regardes dans Insertion/nom/definir comment cette plage est définie, si tu ne coprends pas tout n'hésite pas
RQ3. cette façon de definir "tablo" permet de le rendre variable, donc, si tu raccourcis ou allonges ton tableau, en le gardant carré, "tablo" suit.

si tu as besoin d'explications, tu dis

michel_m · Answer

Bonjour

Excuse l'incruste, Gord2&, mais le pb m'a hachement intéressé
proposition (j'ai colorié à cause de mes yeux)

Sub robot()
lig_dep = 1
col_dep = 1
With Cells(lig_dep, col_dep)
     lig_fin = .End(xlDown).Row - 1
     col_fin = .End(xlToRight).Column
End With
For lig = lig_dep To lig_fin
     col = col_dep
     nbre_0 = Application.CountIf(Range(Cells(lig, col), Cells(lig, col_fin)), 0) - 1
     If nbre_0 > 0 Then
          For cptr = 1 To 7
               If Cells(lig, col) = 0 Then
                    Set carre = Range(Cells(lig, col), Cells(lig + 1, col + 1))
                     'If Application.Sum(carre) = 0 Then carre.Font.Bold = True
                      If Application.Sum(carre) = 0 Then carre.Interior.ColorIndex = 6
                     nbre = nbre + 1
                     If nbre = nbre_0 Then Exit For
               End If
               col = col + 1
           Next
     End If
Next
End Sub

demo
https://www.cjoint.com/?3Filf2jDaL1

ccm81 · Answer

re 

si le tableau doit contenir des négatifss
remplacer  
            If Application.WorksheetFunction.Sum(carre) = 0 Then 
par 
            If Application.CountIf(carre, 0) = (dli + 1) ^ 2 Then

taniafifi · Answer

Coucou à vous deux ,
enffet c'est la première fois que je m'inscris à un forum j'y croyais pas au début que on pouvait s'entres aider c'est vraiment encouragant  merci bien à vous deux(je sais que ca n'a rien avoir avec l'énoncer lol!"), 
donc revenant à nos moutons ou plutot à mes moutons lollll!

@ccm81: pour que je réponds à ta question enffet le tableau que j'ai donner en exemple n'a rien avoir avec celui que je travail avec si tu veux je te l'envoi par mail.
je t'explique : enffet je dois automatiser une méthode est dans ce projet j'ai  36 sites chaque site dans dans une ligne avec le meme site  dans une colonne 
par exemple dans l'entete  A :site1 ligne1: site1, B:site2 ligne2:site2 ... et dans le milieu du tableau des numéros .
moi ce k'il faut que je fasse c'est trouver en parourant tout le tableau deux sites sucessives ou 3sites sucessives l'important que ca dépasse pas 4 sites ou il 'ya une symétrie de 0 comme ce que j'ai montrer dans le tableau en haut :
                     A (site1)       B(site2)       C(site3)     D     E  . . . . .  
lig1(site1)          0                 0                  20          5     12
lig2(site2)          0                 0                  12           6     0
lig3(site3)           6                 0                  0             0
lig4(site4)           12               0                   0             0
.                           12              0                   0              0
. 
.
.    


donc on faite le programme devrai parcourir la première ligne et la deuxiéme et la troisiéme et quatriéme kan il va trouvé les 4zéro la symétrie entre (le site 1 et le site 2 ),(site1 et site 1) (site2 et site2) (site 2 et site 1) il va me les mettre en gras et me les encadrée par exemple aprés il va passé a la 3éme ligne et il va chercher il va trouvé les 9zéro il va faire la meme chose juska kil finisse enffet c'est ca mon projet.

ccm81 · Answer

re 

1. pour envoyer ton tableau tu utilises cijoint.fr ou cjoint.com et tu mets le lien obtenu dans ton prochain post (au format excel 2003) 

2. comme il y a une nouveauté dans ta demande, pas plus de 4x4 pour la taille des sous tableaux de 0, il faut faire un correctif à la condition d'arret qui devrait devenir 
        ' on arrete quand li+dli >=n ou que pas trouve ou que dli = 4 
        Loop Until Not trouve Or li + dli >= n Or dli = 4

3. pour definir le tableau deux solutions 
- celle que j'ai adopté avec un nom de plage défini de façon dynamique avec tablo =DECALER(Feuil1!$A$1;0;0;NB(Feuil1!$A:$A);NB(Feuil1!$A:$A)) 
- celle qu'a adopté michel_m où la plage correspondante est définie dans le programme VBA 
RQ. si/comme ton tableau est de dimension fixe, le problème est bien sûr plus simple 

comme tu as pu voir, en plus d'apporter un peu de solidarité dans ce monde de brutes, le forum permet en plus de s'entraider, de discuter des différents points de vues sur une question,et ça,  c'est toujours enrichissant. 

bonne suite

taniafifi · Answer

http://www.cijoint.fr/cjlink.php?file=cj201106/cijX8XKDhX.xls
ahh hihi voila mon dossier excel c la feuille 3

ccm81 · Answer

re

je ne vois pas où est le pb, 
1. tu enlèves le gras et le remplissage "à la main"
2. tu nomme tablo la plage (sans les têtes de lignes et de colonnes)
3. tu mets deux boutons dans la feuille
4. tu colles les codes dans les CommandButton(S)_Click de tes boutons

RQ1. pour mettre  la couleur jaune, les bordures et le gras (bouton OK)

              carre.Interior.ColorIndex = 6
              carre.Font.FontStyle = "gras"
              carre.Borders.LineStyle = xlContinuous
RQ2. pour remettre en l'état (bouton RAZ)
      Range("tablo").Cells(li, co).Font.FontStyle = "Normal"
      Range("tablo").Cells(li, co).Interior.ColorIndex = xlNone
      Range("tablo").Cells(li, co).Borders.LineStyle = xlNone
bonne suite

taniafifi · Answer

Oui c'est ca ca marche je sais pas comment te remercier tu me sauve la vie c'est trés gentil à toi.
Et encore merci pour ta générosité à bientot.
je voulez savoir si j'avais une question est ce que je pourrais te la demander si j'abuse pas !?

VBA sous Excel

16 réponses

Newsletters