Demande de correction de macro

Version imprimable

1 pièce(s) jointe(s)

Bonjour
je n'arrive pas a optimiser la macro (ice)dans le module 1
le but et de transposer dans la plage (M3:T10) les deux plages (W3:AD10,C3:J10)
en récupérant uniquement les cellules non vide et d'imbriquer la macro ice dans la macro qui se trouve
dans la feuil 1
j' ai fais un essai avec Range("M3:T10").Value = Application.Union(Range("W3:AD10"), Range("C3:J10")).Value
mais j' ai toujours le meme problème il n y a qu'une des deux plages qui arrive dans ("M3:T10")
voici la macro problematique

Code:

1
2
3
4
5
6
Sub ice()
Range("M3:T10").Value = Range("W3:AD10,C3:J10").Value
If Range("W3:AD10,C3:J10") <> "" Then
Range("A1").Select
End If
End Sub

et voici la macro dans la quel je souhaite imbriquer la macro ice

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim isect As Range, c As Range
    Set isect = Intersect(Target, [AC3:AD4,AC6:AD7,AC9:AD10])
    If Not isect Is Nothing Then
        For Each c In Target.Cells
            If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then
                c.Offset(, -20) = IIf(IsEmpty(c), TimeSerial(7, 30, 0), Empty)
            End If
        Next c
 
    End If
    Set isect = Intersect(Target, [Z3:AA4,Z6:AA7,Z9:AA10])
    If Not isect Is Nothing Then
        For Each c In Target.Cells
            If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then
                c.Offset(, -20) = IIf(IsEmpty(c), TimeSerial(3, 45, 0), Empty)
            End If
        Next c
    End If
    Set isect = Intersect(Target, [W3:X4,W6:X7,W9:X10])
    If Not isect Is Nothing Then
        For Each c In Target.Cells
            If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then
                c.Offset(, -20) = IIf(IsEmpty(c), TimeSerial(15, 0, 0), Empty)
            End If
 
        Next c
      End If
      ice
End Sub

Merci d'avance

14/12/2017, 10h44
Invité

Bonjour

Merci de donner plus de détails, notamment en mettant le code qui pose problème sur la discussion.

A lire pour les pièces jointes : https://www.developpez.net/forums/d8...s-discussions/

Le fait de détailler sur le forum t'apportera plus de contributeurs.

Philippe
14/12/2017, 11h31
a_diard

le but et de transposer dans la plage (M3:T10) les deux plages (W3:AD10,C3:J10)

pour moi ta demande n'est pas claire

tu souhaite mette deux plages de cellules qui font chacune 8 lignes et 8 colonnes

dans une plage de cellule qui fait 8 lignes et 8 colonnes

forcément ça déborde.......

peut tu être plus précis.

si tu veux mettre toutes les valeurs des 2 plages (W3:AD10,C3:J10)
dans la plage (M3:T10)

il faut qu'il y ai au maximum 64 cellules avec des valeurs.

Avec quelle logique ?????
14/12/2017, 11h55
samchich

Citation:

Envoyé par a_diard

pour moi ta demande n'est pas claire

tu souhaite mette deux plages de cellules qui font chacune 8 lignes et 8 colonnes

dans une plage de cellule qui fait 8 lignes et 8 colonnes

forcément ça déborde.......

peut tu être plus précis.

si tu veux mettre toutes les valeurs des 2 plages (W3:AD10,C3:J10)
dans la plage (M3:T10)

il faut qu'il y ai au maximum 64 cellules avec des valeurs.

Avec quelle logique ?????

Bonjour et merci pour ton interet

si une cellule et vide dans la plage (W3:AD10) la meme cellule dans la plage (C3:J10) est automatiquement renseigner
Et (M3:T10) qui synthétise les deux plages (W3:AD10,C3:J10)

J’espère être suffisamment explicite

Bonjour,si j'ai bien compris ton besoin ....

Je copie la zone Range("W3:AD10") dans Range("M3:T10")

puis pour les cellules vides dans Range("M3:T10") , je vais chercher la valeur de la cellule dans Range("C3:J10")
Code:

1 2 3 4 5 6 7 8 9 10 Sub samchich() Range("M3:T10").Value = Range("W3:AD10").Value For ligne = 3 To 10 For colonne = 13 To 20 If Len(Cells(ligne, colonne).Value) = 0 Then Cells(ligne, colonne).Value = Cells(ligne, colonne - 10).Value End If Next Next End Sub

à La Rache

Code:

1
2
3
4
5
6
7
8
9
10
Sub compil()
tb1 = Range("w3:ad10")
tb2 = Range("c3:j10")
For t = 1 To UBound(tb1, 1)
For u = 1 To UBound(tb1, 2)
If tb1(t, u) = "" Then tb1(t, u) = tb2(t, u)
Next
Next
Range("m3:t10").Value = tb1
End Sub

2 pièce(s) jointe(s)

Citation:
Envoyé par Daranc
à La Rache
Code:

1 2 3 4 5 6 7 8 9 10 Sub compil() tb1 = Range("w3:ad10") tb2 = Range("c3:j10") For t = 1 To UBound(tb1, 1) For u = 1 To UBound(tb1, 2) If tb1(t, u) = "" Then tb1(t, u) = tb2(t, u) Next Next Range("m3:t10").Value = tb1 End Sub
Pièce jointe 335191Pièce jointe 335195

Bonjour
J'ai essayer ca mais erreur !

15/12/2017, 10h40
Daranc

ça met erreur ?
quel lien avec le code cité?
qu'est sensé faire la macro qui est en erreur? sil elle doit juste tester si tu as un changement sur ta feuille dans certaines zone , fait lui lancer la macros 2 par un call
15/12/2017, 12h07
unparia

Bonjour
En outre : la syntaxe de la ligne dénoncée est une véritable aberration ! (et intersect n'a pas grand-chose à voir dans cette aberration !)

Re
quant j'appel une macro a la fin de celle ci elle plante !

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim isect As Range, c As Range
    Set isect = Intersect(Target, [AC3:AD4,AC6:AD7,AC9:AD10])
    If Not isect Is Nothing Then
        For Each c In Target.Cells
            If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then
                c.Offset(, -20) = IIf(IsEmpty(c), TimeSerial(7, 30, 0), Empty)
            End If
        Next c
 
    End If
    Set isect = Intersect(Target, [Z3:AA4,Z6:AA7,Z9:AA10])
    If Not isect Is Nothing Then
        For Each c In Target.Cells
            If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then
                c.Offset(, -20) = IIf(IsEmpty(c), TimeSerial(3, 45, 0), Empty)
            End If
        Next c
    End If
    Set isect = Intersect(Target, [W3:X4,W6:X7,W9:X10])
    If Not isect Is Nothing Then
        For Each c In Target.Cells
            If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then
                c.Offset(, -20) = IIf(IsEmpty(c), TimeSerial(15, 0, 0), Empty)
            End If
 
        Next c
      End If
 
End Sub

15/12/2017, 18h04
unparia

n étant un nombre entier > 0
n mod 1 est forcément toujours égal à 0 (et donc <> 1)
et
n mod 2 ne saurait jamais être égal à 2
cette ligne de code est surprenante, insensée (surtout le mod 1 <> 1 :pleure:) et ne donne pas vraiment envie de t'aider

Code:

If c.Row Mod 1 <> 1 And c.Column Mod 2 <> 2 Then