Início / computer / Perguntas / 1794273
Accepted
Rax
Asked: 2023-07-06 21:33:15 +0800 CST

VBA para copiar valor e loop para cada linha

  • 772

Eu tenho um intervalo de colunas com células em branco. Estou tentando copiar se alguma dessas células contém um texto. Para isso, escrevi o código a seguir, que funciona bem para a primeira linha. Como repetir isso para cada linha até a última linha usada?

Dim SrchRng As Range, cel As Range
Set SrchRng = Sheet1.Range("BI2:CZ2")
        For Each cel In SrchRng
        If cel.Value <> "" Then
        Sheet1.Range("AH2").Value = cel.Value
    End If
Next cel
vba

2 respostas

  1. Best Answer

    Você quase fez tudo certo - falta apenas uma nuance: depois de escrever na célula de destino, você precisa mover esta célula para a direita ou para baixo. Isso pode ser feito, por exemplo, assim:

    Sub copyNonEmptyCells()
Dim SrchRng As Range, cel As Range, targetCel As Range
    Set SrchRng = Sheet1.Range("BI2:CZ2")
    Set targetCel = Sheet1.Range("AH2")
    For Each cel In SrchRng.Cells
        If cel.Value <> "" Then
            targetCel.Value = cel.Value
            Set targetCel = targetCel.Offset(0, 1) ' or (1,0)
        End If
    Next cel
End Sub

    Caso você queira concatenar todos os valores não vazios de cada linha do intervalo em uma célula, conforme indicado em seu comentário, o código da macro não se torna muito mais complicado:

    Sub joinNonEmptyCells()
Dim SrchRng As Range, cel As Range, targetCel As Range, oSingleRow As Range
    Set SrchRng = Sheet1.Range("BI2:CZ100")
    Set targetCel = Sheet1.Range("AH2")
    targetCel.Value = ""
    For Each oSingleRow In SrchRng.Rows
        For Each cel In oSingleRow.Cells
            If cel.Value <> "" Then
                targetCel.Value = targetCel.Value & " " & cel.Value
            End If
        Next cel
        targetCel.Value = Trim(targetCel.Text)
        Set targetCel = targetCel.Offset(1, 0)
        targetCel.Value = ""
    Next oSingleRow
End Sub
    • 0

  2. Tente o código abaixo. Ele primeiro localiza a última linha da planilha. Em seguida, percorra as linhas (da linha 2 até a última) e defina os valores, se encontrados, em AH.

    Public Sub Test()

Dim SrchRng As Range, cel As Range
Dim lastRow As Long
'Get the last row
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

    For x = 2 To lastRow 'Loop the rows
        Set SrchRng = Sheet1.Range("BI" & x & ":CZ" & x)
        For Each cel In SrchRng 'Loop through each row
            If cel.Value <> "" Then
                Sheet1.Range("AH" & x).Value = cel.Value
            End If
        Next cel

    Next x
End Sub
    • 0

relate perguntas