1
votes

Excel VBA: si la cellule contient du texte, saisissez une plage de cellules avec ce contenu

Souhaiterait qu'une plage de colonnes soit recherchée pour un texte spécifique ("RAISON") et, une fois trouvée, que tout le contenu de la cellule soit rempli sur une plage de cellules différentes.

Ceci est fait jusqu'à ce qu'un nouveau "RAISON" soit trouvé - auquel cas le contenu de cette cellule sera copié comme avant.

Ceci est avant le résultat: avant

... et résultat attendu, avec texte rempli dans la colonne J after

Merci les gars, j'ai joué avec ça mais je ne sais pas où aller à partir d'ici:

Sub AddSus()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
  If InStr(1, cel.Value, "REASON") > 0 Then
     cel.Offset(1, 0).Value = cel.Value
  End If
Next cel
End Sub


3 commentaires

Les captures d'écran sont les mêmes.


merci @Vincent G ... édité


cela peut être fait en utilisant une formule matricielle, quelque chose comme = OFFSET ($ G $ 1, MAX (($ G $ 1: $ G $ 10 = "") * (ROW ($ G $ 1: $ G $ 10)


3 Réponses :


0
votes

Utilisez FIND pour sauter rapidement entre les instances de RAISON :

Sub AddSus()

    Dim SrchRng As Range
    Dim rFound As Range
    Dim lStart As Long, lEnd As Long
    Dim sFirstAddress As String
    Dim sReason As String

    Set SrchRng = ThisWorkbook.Worksheets("Sheet1").Range("G:G")

    'Find the first instance of REASON in column G.
    Set rFound = SrchRng.Find(What:="REASON:", _
                       After:=SrchRng.Cells(1, 1), _
                       LookIn:=xlValues, _
                       LookAt:=xlPart, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlNext, _
                       MatchCase:=True)

    'Check something has been found before continuing.
    If Not rFound Is Nothing Then

        'Find just keeps looping unless you tell it to stop,
        'so record the first found address.
        sFirstAddress = rFound.Address
        Do
            'Save the reason and start row.
            sReason = rFound.Value
            lStart = rFound.Row

            'Find the next REASON in column G.
            Set rFound = SrchRng.FindNext(rFound)

            If rFound.Address = sFirstAddress Then
                'The first instance has been found again, so use column I to find last row of data.
                lEnd = SrchRng.Offset(, 2).Cells(Rows.Count, 1).End(xlUp).Row
            Else
                lEnd = rFound.Row
            End If

            'Fill in from 2 rows down from Start and 2 rows up from End.
            'This will go wrong if there's not enough space between REASONs.
            With ThisWorkbook.Worksheets("Sheet1")
                .Range(.Cells(lStart + 2, 10), .Cells(lEnd - 2, 10)) = sReason
            End With

        Loop While rFound.Address <> sFirstAddress
    End If

End Sub


0 commentaires

1
votes

Il y a quelques problèmes avec ceci. Au fur et à mesure que vous parcourez cel dans SrchRng , votre conditionnel vérifie que la valeur de ce cel contient "RAISON". Ce n'est pas ce que tu veux. Ce que vous faites essentiellement est de vérifier la chaîne "RAISON" et de dire que toutes les entrées ci-dessous, jusqu'à la prochaine raison, devraient être vraies pour qu'un conditionnel remplisse la colonne J.

Permet, vraiment brièvement , parcourez la logique d'une seule cellule pour illustrer pourquoi votre code ne faisait pas ce que vous vouliez: Dans la cellule G3, vous vérifiez si elle contient la chaîne "RAISON". Ce n'est pas le cas, il n'y a donc aucune affectation de valeur nulle part. Ce qui suit fera ce que vous voulez:

Sub AddSus()
Dim SrchRng As Range, cel As Range, reasonString As String
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
    If InStr(1, cel.Value, "REASON") > 0 Then
        reasonString = cel.Value
    ElseIf cel.Value <> "" Then
        cel.Offset(0, 3).Value = reasonString
  End If
Next cel
End Sub

Note mineure mais si vous êtes dans la colonne G et que vous voulez remplir la colonne J, le décalage doit être .offSet ( 0,3) .


0 commentaires

0
votes

Une solution rapide et sale ...

Sub AddSus()

    Dim SrchRng As Range, cel As Range
    Dim reason As String

    Set SrchRng = Range("g1:g60")

    For Each cel In SrchRng

        If InStr(1, cel.Value, "REASON") > 0 Then
            reason = cel.Value
        End If

        If cel.Column = 10 And Len(cel.Offset(,-1)) > 0 Then
            cel.Value = reason
        End If

    Next

End Sub


0 commentaires