VB Excel

VB Excel - VB/VBA/VBS - Programmation

Marsh Posté le 01-04-2012 à 12:33:54    

Bonjour,  
 
Je débute un peu en Visual Basic et j'en ai besoin pour faciliter des calculs sur Excel.
 
Voila le tableau dans lequel j'entre les valeurs. Le but est de calculer la somme des différentes longueurs, selon l'orientation de la facette (Nord, Ouest, ...) et la zone à laquelle elle appartient, et ce pour chaque étage d'un bâtiment (N0, N1, ...)
http://img651.imageshack.us/img651/7620/donnes.jpg
Les sommes des différentes longueurs ont été faites après l'exécution de la macro, pour vérifier les résultats.
 
Pour l'instant j'ai réussi à le faire avec un code assez immonde, mais il faut mettre en forme à chaque fois le tableau de résultats.
 

Code :
  1. For N = 0 To 9 Step 3  'pour les 3 étages du bâtiment
  3. For A = 0 To 9
  5.     If Cells(35 + A, 2 + N) <> 0 Then Cells(35 + A, 1 + N) = 0 'remise à 0 des cellules résultat'
  6.    
  7. Next A
  9. For i = 3 To 31
  10.    
  11.     If Cells(i, 2 + N) = Cells(35, 2 + N) And Cells(i, 3 + N) = Cells(35, 3 + N) Then
  12.         Cells(35, 1 + N) = Cells(35, 1 + N) + Cells(i, 1 + N)
  13.     End If
  14.    
  15.     If Cells(i, 2 + N) = Cells(36, 2 + N) And Cells(i, 3 + N) = Cells(36, 3 + N) Then
  16.         Cells(36, 1 + N) = Cells(36, 1 + N) + Cells(i, 1 + N)
  17.     End If
  18.    
  19.     If Cells(i, 2 + N) = Cells(37, 2 + N) And Cells(i, 3 + N) = Cells(37, 3 + N) Then
  20.         Cells(37, 1 + N) = Cells(37, 1 + N) + Cells(i, 1 + N)
  21.     End If
  22.    
  23.     If Cells(i, 2 + N) = Cells(38, 2 + N) And Cells(i, 3 + N) = Cells(38, 3 + N) Then
  24.         Cells(38, 1 + N) = Cells(38, 1 + N) + Cells(i, 1 + N)
  25.     End If
  26.    
  27.     If Cells(i, 2 + N) = Cells(39, 2 + N) And Cells(i, 3 + N) = Cells(39, 3 + N) Then
  28.         Cells(39, 1 + N) = Cells(39, 1 + N) + Cells(i, 1 + N)
  29.     End If
  30.    
  31.     If Cells(i, 2 + N) = Cells(40, 2 + N) And Cells(i, 3 + N) = Cells(40, 3 + N) Then
  32.         Cells(40, 1 + N) = Cells(40, 1 + N) + Cells(i, 1 + N)
  33.     End If
  34.    
  35.     If Cells(i, 2 + N) = Cells(41, 2 + N) And Cells(i, 3 + N) = Cells(41, 3 + N) Then
  36.         Cells(41, 1 + N) = Cells(41, 1 + N) + Cells(i, 1 + N)
  37.     End If
  38.    
  39.     If Cells(i, 2 + N) = Cells(42, 2 + N) And Cells(i, 3 + N) = Cells(42, 3 + N) Then
  40.         Cells(42, 1 + N) = Cells(42, 1 + N) + Cells(i, 1 + N)
  41.     End If
  42.    
  43.     If Cells(i, 2 + N) = Cells(43, 2 + N) And Cells(i, 3 + N) = Cells(43, 3 + N) Then
  44.         Cells(43, 1 + N) = Cells(43, 1 + N) + Cells(i, 1 + N)
  45.     End If
  46.    
  47.     If Cells(i, 2 + N) = Cells(44, 2 + N) And Cells(i, 3 + N) = Cells(44, 3 + N) Then
  48.         Cells(44, 1 + N) = Cells(44, 1 + N) + Cells(i, 1 + N)
  49.     End If
  50.    
  51. Next i
  53. Next N


 
Les résultats doivent s'afficher dans un tableau qu'il faut mettre en place à l'avance :
http://img163.imageshack.us/img163/9589/miseenforme.jpg
 
Le tableau de résultats s'affiche au final sous cette forme :
http://img525.imageshack.us/img525/3793/rsultats.jpg
Encore une fois, les sommes des longueurs n'ont qu'un but de vérification.
 
 
mon but : ne plus avoir à mettre en forme le tableau de résultats, pour que les sommes se fassent directement avec l'affichage de l'orientation et de la zone correspondante, pour les 3 étages
 
 
Auriez-vous des pistes pour m'aider ?  
 
Merci d'avance.


Message édité par clem_tj77 le 01-04-2012 à 13:08:06
Reply

Marsh Posté le 01-04-2012 à 12:33:54   

Reply

Marsh Posté le 03-04-2012 à 08:46:47    

Bonjour,
 
Voilà un exemple de code pour ton projet. Le code reste tout de même à tester dans divers cas de figure et à améliorer si nécessaire.
 

Code :
  1. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  3. '***************************'
  4. '* Exemple de mise en page *'
  5. '***************************'
  7. 'Réinitialisation de la borduration'
  8. Range("A:L" ).Borders.LineStyle = xlNone
  10. 'Renseignement des cellules'
  11. Range("A2,D2,G2,J2" ) = "Longueur"
  12. Range("B2,E2,H2,K2" ) = "Orientation"
  13. Range("C2,F2,I2,L2" ) = "Zone"
  15. 'Aignement des cellules'
  16. Range("A2:L2" ).HorizontalAlignment = xlCenter
  18. 'Ajustement largeur des colonne'
  19. Range("A2:L2" ).Columns.AutoFit
  21. 'Borduration des titres'
  22. With Range("A2:L2" ).Borders(xlEdgeTop)
  23.     .LineStyle = xlContinuous
  24.     .ColorIndex = xlAutomatic
  25.     .TintAndShade = 0
  26.     .Weight = xlMedium
  27. End With
  29. 'Borduration du total en A'
  30. With Range("A65535" ).End(xlUp).Borders(xlEdgeTop)
  31.     .LineStyle = xlContinuous
  32.     .ColorIndex = xlAutomatic
  33.     .TintAndShade = 0
  34.     .Weight = xlMedium
  35. End With
  37. 'Borduration du total en D'
  38. With Range("D65535" ).End(xlUp).Borders(xlEdgeTop)
  39.     .LineStyle = xlContinuous
  40.     .ColorIndex = xlAutomatic
  41.     .TintAndShade = 0
  42.     .Weight = xlMedium
  43. End With
  45. 'Borduration du total en G'
  46. With Range("G65535" ).End(xlUp).Borders(xlEdgeTop)
  47.     .LineStyle = xlContinuous
  48.     .ColorIndex = xlAutomatic
  49.     .TintAndShade = 0
  50.     .Weight = xlMedium
  51. End With
  53. 'Borduration du total en J'
  54. With Range("J65535" ).End(xlUp).Borders(xlEdgeTop)
  55.     .LineStyle = xlContinuous
  56.     .ColorIndex = xlAutomatic
  57.     .TintAndShade = 0
  58.     .Weight = xlMedium
  59. End With
  61. 'Borduration verticale'
  62. Dim LastCell As Integer
  63. LastCell = ActiveSheet.UsedRange.Rows.Count
  65. With Range("C2:C" & LastCell).Borders(xlEdgeRight)
  66.     .LineStyle = xlContinuous
  67.     .ColorIndex = xlAutomatic
  68.     .TintAndShade = 0
  69.     .Weight = xlMedium
  70. End With
  72. With Range("F2:F" & LastCell).Borders(xlEdgeRight)
  73.     .LineStyle = xlContinuous
  74.     .ColorIndex = xlAutomatic
  75.     .TintAndShade = 0
  76.     .Weight = xlMedium
  77. End With
  79. With Range("I2:I" & LastCell).Borders(xlEdgeRight)
  80.     .LineStyle = xlContinuous
  81.     .ColorIndex = xlAutomatic
  82.     .TintAndShade = 0
  83.     .Weight = xlMedium
  84. End With
  86. End Sub


 
@+

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed