XL 2013 remplacement cellule par une autre

jcpat

XLDnaute Occasionnel
Bonjour,
j’espère que vous allez toutes et tous très bien.
Voilà je vous soumet ma problématique, je désire en macro remplacer une cellule par une autre située juste en dessous.
Je m'explique :)
Dans un tableau dans mon exemple, en B1 j'ai un horaire et en B2 j'ai congé, je voudrais si possible pouvoir remplacer automatiquement la cellule B1 par B2 si je trouve congé.
Ce n'est qu'un exemple le tableau peut être sur une semaine entière ...

Merci @ vous
:cool:
 

Pièces jointes

  • remplacement cellule.xlsx
    11.1 KB · Affichages: 12

jcpat

XLDnaute Occasionnel
Hello ,

je reviens sur mon file pour compléter celui ci suite à une nouvelle problématique, sachant que tout ce que vous m'avez apporté avant m'a été très utile :),

voila dans le fichier que je joint j'ai 2 macros , CTRL B pour dé fusionner mes cellules et mettre dans chaque cellule le terme congés et CTRL P pour rechercher les horaires et remplacer par CONGÉS.

Le problème est le suivant , dans mon tableau il peut y avoir des décalages de ligne, du coup en ligne 1 j'ai mes horaires en ligne 2 j'ai le terme CONGES et en ligne 3 aussi le terme CONGES, lorsque que je fait CTRL B cela defusionne bien mes ligne 2 et 3 et me place CONGES dans chaque cellule mais lorsque je fait CTRL P pour remplacer mes termes cela ne s'applique que sur la cellule au dessus (ce qui est normal car la macro demande cela ) , mais du coup ma ligne 3 ne s'applique pa correctement pour appliquer CONGES sur la ligne 1 . OUF :)

pour mieux comprendre ouvrir mon fichier puis faire CTRL B puis CTRL P

ce que je cherche à faire c'est que la ligne 3 s'applique bien sur la ligne 1.

(à savoir qu'aprés cela je l'applique sur un fichier bien plus grand du coup je découvre les failles au fil de l'utilisation :)

Merci pour votre aide si précieuse

JC
 

Pièces jointes

  • horaire.xlsm
    37.7 KB · Affichages: 9
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour jcpat, JBARBE,

Je ne fais que passer et je vois que vous défusionnez alors que c'est bien inutile :
VB:
Sub CONGES()
Dim P As Range, ncol%, i&, j%
Set P = ActiveSheet.UsedRange
ncol = P.Columns.Count
For i = 2 To P.Rows.Count
    For j = 1 To ncol
        If P(i, j).MergeArea(1) = "CONGES" Then P(i - 1, j).MergeArea(1) = "CONGES"
Next j, i
End Sub
A+
 

Pièces jointes

  • CONGES(1).xlsm
    17.5 KB · Affichages: 10

jcpat

XLDnaute Occasionnel
hi,

ah oui c'est un raccourci efficace, merci :) JOB75, impeccable pour ligne 2 vers 1 ,
il me manque plus que ligne 3 vers 1 (j'ai modifié du coup le fichier..) :cool:
 

Pièces jointes

  • Copie de CONGES(1)-3.xlsm
    15.4 KB · Affichages: 4
Dernière édition:

job75

XLDnaute Barbatruc
Fichier (2) avec la macro modifiée :
VB:
Sub CONGES()
Dim P As Range, ncol%, i&, j%
Set P = ActiveSheet.UsedRange
ncol = P.Columns.Count
For i = 2 To P.Rows.Count
    For j = 1 To ncol
        If P(i, j).MergeArea(1) = "CONGES" Then
            If P(i - 1, j).MergeArea(1) <> "" Then
                P(i - 1, j).MergeArea(1) = "CONGES"
            ElseIf i > 2 Then
                If P(i - 2, j).MergeArea(1) <> "" Then P(i - 2, j).MergeArea(1) = "CONGES"
            End If
        End If
Next j, i
End Sub
 

Pièces jointes

  • CONGES(2).xlsm
    17.4 KB · Affichages: 7

job75

XLDnaute Barbatruc
Ce fichier (3) est beaucoup mieux, qui peut le plus peut le moins :
VB:
Sub CONGES()
Dim P As Range, ncol%, i&, j%, k&
Set P = ActiveSheet.UsedRange
ncol = P.Columns.Count
For i = 2 To P.Rows.Count
    For j = 1 To ncol
        If P(i, j).MergeArea(1) = "CONGES" Then
            For k = i - 1 To 1 Step -1
                If P(k, j).MergeArea(1) <> "" Then P(k, j).MergeArea(1) = "CONGES": Exit For
            Next k
        End If
Next j, i
End Sub
 

Pièces jointes

  • CONGES(3).xlsm
    17.6 KB · Affichages: 6

jcpat

XLDnaute Occasionnel
au top merci job75, cela dépasse très largement mes compétences en VBA , j'ai testé dans mon fichier final et c'est OK à 95% , les 5% qui m'embête c'est cette cellule qui se trouve en plus dans le fichier et qui bloque la copie dans l'autre cellule :-(
 

Pièces jointes

  • Copie de CONGES(3)-2.xlsm
    15.8 KB · Affichages: 3

jcpat

XLDnaute Occasionnel
alors j'ai trouvé une solution, pas très VBA mais qui me suffira par un CTRL H et je vide la case pour la libérer ... du coup cela donne l'espace vide pour copier la cellule,
Par contre possible de rajouter dans la macro en de congé la même manip mais pour COMP... et normalement avec tout cela je pourrais m'en sortir pour finaliser mon fichier :)

Merci encore pour le super travail Job75
 

Pièces jointes

  • Copie de CONGES(3)-2.xlsm
    16 KB · Affichages: 2

job75

XLDnaute Barbatruc
Bonjour jcpat, le forum,

J'avais donné hier soir plusieurs solutions que j'ai supprimées.

Dans ce fichier (4) celle-ci me semble complète :
VB:
Sub CONGES_COMP()
Dim liste, d As Object, e, P As Range, ncol%, i&, j%, k&, x
liste = Array("CONGES", "COMP") 'à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each e In liste: d(e) = "": Next
Set P = ActiveSheet.UsedRange
ncol = P.Columns.Count
For i = 2 To P.Rows.Count
    For j = 1 To ncol
        If d.exists(P(i, j).MergeArea(1).Value) Then
            For k = i - 1 To 1 Step -1
                x = P(k, j).MergeArea(1)
                If d.exists(x) Then Exit For
                If Val(x) Then P(k, j).MergeArea(1) = P(i, j).MergeArea(1): Exit For
            Next k
        End If
Next j, i
End Sub
- les textes à traiter sont placés dans l'Array liste

- les valeurs situées au-dessus de chacun de ces textes sont remplacées si elles commencent par un nombre, c'est la fonction Val qui les distingue

- le Dictionary permet d'accélérer la macro.

Bonne journée.
 

Pièces jointes

  • CONGES(4).xlsm
    19.5 KB · Affichages: 6

jcpat

XLDnaute Occasionnel
Bonsoir Job75,

Merci vraiment Job75 pour le temps consacré et pour la solution apportée à mon problème.
C'est parfait je vais pouvoir adapter cela à mon fichier, merci aussi pour les explications qui sont précises. Quel plaisir d'avoir des experts aussi efficace :)

Bonne soirée et @ bientôt ;-)
 

Discussions similaires

Réponses
5
Affichages
234

Statistiques des forums

Discussions
314 450
Messages
2 109 727
Membres
110 552
dernier inscrit
jasson