[VBA7.1] Fonction Range avec constante de cellules

Version imprimable

04/11/2022, 18h50
Mailloch38

[VBA7.1] Fonction Range avec constante de cellules

Bonjour à tous, je suis tout nouveau dans le codage via VBA

Et je n'arrive pas a régler un problème sur ma fonction Range! :oops:

Citation:

Range(LaVoie & "_B") = Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_MATERIEL)

La constante (COL_DEST_DEPART_MATERIEL) peut contenir plusieurs cellules : j'aimerai lorsque qu'il y a plusieurs données dans cette constante qu'elles les fusionnent, en gardant le texte, dans une seule et même cellule.

Désolé si vous n'arrivez pas a me comprendre, ce monde du programme et tout nouveau pour moi. :)

Pas compris ...
Tu peux donner un exemple concret ?

Sinon, copier / coller ?
Exemple:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
 
Public Sub test()
    Dim Wb As Excel.Workbook
    Set Wb = ThisWorkbook
 
    Dim Ws As Excel.Worksheet
    Set Ws = Wb.Worksheets("Feuil1")
 
    Dim Source As Excel.Range
    Set Source = Ws.Range("A1:A10")
 
    Dim Target As Excel.Range
    Set Target = Ws.Range("B1:B10")
 
    Source.Copy Target
End Sub

04/11/2022, 19h13
Mailloch38

1 pièce(s) jointe(s)

Je veux que que les données d'une cellule (voir deux si le cas échéant) se copie colle.

Lorsque j'ai deux cellules pour une seul et même constante celle ci échoue.

J'ai mis le fichier ci joint c'est quand j'effectue mon module de TOF que celui ci ne veut pas fonctionner car deux éléments(cellules) pour une seule cellule

Pièce jointe 628391

Ok, je commence à comprendre.

Le coupable est cette instruction:
LaVoie = SupprimerEspace(Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_GARAGE))

Le problème est que tu vas lire des cellules fusionnées.
Il te faut tester la propriété MergeCells de la plage, et lire la première cellule de la plage fusionnée, que tu obtiens via la propriété MergeArea.
La fonction suivante devrait te satisfaire:
Code:

1 2 3 4 5 6 7 8 9 Private Function GetCellValue(ByRef Rng As Excel.Range) As String If (Rng.MergeCells) Then Dim Data As Excel.Range Set Data = Rng.MergeArea GetCellValue = Data.Cells(1).Value Else GetCellValue = Rng.Value End If End Function
Autre points:
- Ajoute la directive Option Explicit en tête de chaque module, et configure ton IDE pour le faire automatiquement.
- Tes fonctions sont trop grandes et violent le SRP (https://en.wikipedia.org/wiki/Single...lity_principle). Divise les en plusieurs fonction plus petites.
- Tu as des variables non déclarées, et non typées.
- Utilise des références explicite plutôt que des références implicites.
- Les objets "Actifs" sont fortement dépendant du contexte, à bannir.
- Evite les noms de fonction avec des accents, ce n'est pas portable.
- Ton code ne devrait pas avoir besoin de sélectionner ni d'activer quoi que ce soit, c'est lent et fait ressembler ton classeur à un sapin de Noël.
- Utilise des références autant que possible pour alléger tes lignes.

Citation:
Envoyé par deedolith
Ok, je commence à comprendre.

Le coupable est cette instruction:
LaVoie = SupprimerEspace(Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_GARAGE))

Le problème est que tu vas lire des cellules fusionnées.
Il te faut tester la propriété MergeCells de la plage, et lire la première cellule de la plage fusionnée, que tu obtiens via la propriété MergeArea.
La fonction suivante devrait te satisfaire:
Code:

1 2 3 4 5 6 7 8 9 Private Function GetCellValue(ByRef Rng As Excel.Range) As String If (Rng.MergeCells) Then Dim Data As Excel.Range Set Data = Rng.MergeArea GetCellValue = Data.Cells(1).Value Else GetCellValue = Rng.Value End If End Function
Autre points:
- Ajoute la directive Option Explicit en tête de chaque module, et configure ton IDE pour le faire automatiquement.
- Tes fonctions sont trop grandes et violent le SRP (https://en.wikipedia.org/wiki/Single...lity_principle). Divise les en plusieurs fonction plus petites.
- Tu as des variables non déclarées, et non typées.
- Utilise des références explicite plutôt que des références implicites.
- Les objets "Actifs" sont fortement dépendant du contexte, à bannir.
- Evite les noms de fonction avec des accents, ce n'est pas portable.
- Ton code ne devrait pas avoir besoin de sélectionner ni d'activer quoi que ce soit, c'est lent et fait ressembler ton classeur à un sapin de Noël.
- Utilise des références autant que possible pour alléger tes lignes.
Merci beaucoup pour tous les conseils, c'est un tableur en phase de test, il faut que je le perfectionne.

le code que tu m'as donner il faut que je le mette dans toute mes macros ou seulement celle où j'ai un problème ?

Je te remercie encore pour toute l'aide que tu me fourni

Bonsoir Mailloch38, deedoliht

Je suis tombé sur le sujet et par curiosité ouvert ton fichier

Je pense qu'on pourrait faire plus simple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub RealisationDuTOF()
  Dim ShtTOF As Worksheet
  Dim MemLaVoie As String
  Dim LaLigneOrig As Integer
  Dim LaDateMatinDepart As Date
  ' En cas d'erreur
  On Error GoTo GestionErreur
  ' Définir la feuille de travail
  Set ShtTOF = ThisWorkbook.Sheets("TOF")
  'Effacement du tof précedent
  ShtTOF.Range("C4:E23").ClearContents
  '
  LaLigneOrig = PRE_LIG_DEST
  LaDateMatinDepart = InputBox("Pour quelle journée souhaitez vous éditer le TOF ?", "Stationnement des rames à SAG", Format(Now + 1, "dd/mm/yyyy"))
  '
  ShtTOF.Range("Libellé") = "Matin du " & LaDateMatinDepart
  '
  While Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_MATERIEL) <> ""
    LaVoie = SupprimerEspace(Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_GARAGE))
    If LaVoie <> "" Then
      MemLaVoie = LaVoie
      ShtTOF.Range(LaVoie) = Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_NUMERO)
      ShtTOF.Range(LaVoie & "_C") = Format(Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_DATE), "dd mmm") & " - " & Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_HEURE)
      ShtTOF.Range(LaVoie & "_B") = Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_MATERIEL)
    Else
      LaVoie = MemLaVoie
      ShtTOF.Range(LaVoie & "_B") = ShtTOF.Range(LaVoie & "_B") & "/" & Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_MATERIEL)
    End If
    LaLigneOrig = LaLigneOrig + 1
  Wend
  Set ShtTOF = Nothing
  Exit Sub
 
GestionErreur:
  Beep
  Call MsgBox("La création du TOF n'est pas parvenue à son terme", vbOKOnly + vbCritical, "Création du TOF")
End Sub

Et la fonction abrégée (si on veut la conserver)

Code:

1
2
3
Function SupprimerEspace(LaVoie As String)
  SupprimerEspace = Replace(LaVoie, " ", "")
End Function

A+

Citation:

Envoyé par BrunoM45

Bonsoir Mailloch38, deedoliht

Je suis tombé sur le sujet et par curiosité ouvert ton fichier

Je pense qu'on pourrait faire plus simple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub RealisationDuTOF()
  Dim ShtTOF As Worksheet
  Dim MemLaVoie As String
  Dim LaLigneOrig As Integer
  Dim LaDateMatinDepart As Date
  ' En cas d'erreur
  On Error GoTo GestionErreur
  ' Définir la feuille de travail
  Set ShtTOF = ThisWorkbook.Sheets("TOF")
  'Effacement du tof précedent
  ShtTOF.Range("C4:E23").ClearContents
  '
  LaLigneOrig = PRE_LIG_DEST
  LaDateMatinDepart = InputBox("Pour quelle journée souhaitez vous éditer le TOF ?", "Stationnement des rames à SAG", Format(Now + 1, "dd/mm/yyyy"))
  '
  ShtTOF.Range("Libellé") = "Matin du " & LaDateMatinDepart
  '
  While Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_MATERIEL) <> ""
    LaVoie = SupprimerEspace(Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_GARAGE))
    If LaVoie <> "" Then
      MemLaVoie = LaVoie
      ShtTOF.Range(LaVoie) = Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_NUMERO)
      ShtTOF.Range(LaVoie & "_C") = Format(Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_DATE), "dd mmm") & " - " & Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_HEURE)
      ShtTOF.Range(LaVoie & "_B") = Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_MATERIEL)
    Else
      LaVoie = MemLaVoie
      ShtTOF.Range(LaVoie & "_B") = ShtTOF.Range(LaVoie & "_B") & "/" & Sheets(NOM_FEUILLE_DEST_GENERALE).Cells(LaLigneOrig, COL_DEST_DEPART_MATERIEL)
    End If
    LaLigneOrig = LaLigneOrig + 1
  Wend
  Set ShtTOF = Nothing
  Exit Sub
 
GestionErreur:
  Beep
  Call MsgBox("La création du TOF n'est pas parvenue à son terme", vbOKOnly + vbCritical, "Création du TOF")
End Sub

Et la fonction abrégée (si on veut la conserver)

Code:

1
2
3
Function SupprimerEspace(LaVoie As String)
  SupprimerEspace = Replace(LaVoie, " ", "")
End Function

A+

Rolalala cela marche parfaitement (je vous admire)

Mille fois merci.

Je vais me penchez quand même sur les différentes remarques que l'on ma fait dessus, remarques bien entendues très constructives.
Merci encore à tous