XL 2013 remplacement cellule par une autre

[jcpat]

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

 

[jcpat]

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

 

[job75]

Bonjour jcpat, JBARBE,

Je ne fais que passer et je vois que vous défusionnez alors que c'est bien inutile :

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+

 

[jcpat]

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..)

 

[job75]

Fichier (2) avec la macro modifiée :

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

 

[job75]

Ce fichier (3) est beaucoup mieux, qui peut le plus peut le moins :

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

 

[jcpat]

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 :-(

 

[jcpat]

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

 

[job75]

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 :

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.

 

[jcpat]

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 ;-)