Início / coding / Perguntas / 76927866
Accepted
Seb358
Asked: 2023-08-18 16:59:40 +0800 CST

percorrer a coluna com a alteração do endereço da célula

  • 772

como faço para que um loop funcione quando tenho alguns endereços de célula que mudam e outros que não. (excel,vba)

então eu tenho um pedaço de código que eu quero executar em 1 coluna (BG9:BG500) e não tenho certeza de como fazer a função de loop executar em todas as células e como escrevê-la para que apenas altere a célula endereços que precisam mudar, deixando os que precisam permanecer estáticos.

Definitivamente, sou um iniciante em macros do Excel e vba, então tudo o que sei atualmente veio de pesquisar no Google como fazer e resolver as coisas por mim mesmo por tentativa e erro, então talvez eu não saiba algumas das coisas que devo saber sobre o vba.

este é o código que desejo executar na coluna.

If Range("B9") = Range("BT28") Then
Range("BR58:CA58").Select
Selection.Copy
Range("BG9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If

os dois endereços de célula que precisam ser alterados são ("B9") e ("BG9"), por exemplo: a primeira execução seria 9, a segunda 10 e assim por diante. Eu tentei usar esta função de loop que encontrei online

Dim iCell As Range
Dim iRange1 As String
Dim iRange2 As String
Dim rangeName As String

iRange1 = ActiveCell.Address
iRange2 = ActiveCell.Address
rangeName = iRange1 & ":" & iRange2

For Each iCell In Range(rangeName).Cells

mas, para ser honesto, não sei o que está acontecendo aqui e gostaria de receber qualquer informação/ajuda com esse problema.

Sub IMPORTTOLIST()

Dim iCell As Range
Dim iRange1 As String
Dim iRange2 As String
Dim rangeName As String

iRange1 = ActiveCell.Address
iRange2 = ActiveCell.Address
rangeName = iRange1 & ":" & iRange2

For Each iCell In Range(rangeName).Cells

If Range(iRange1) = Range("BT28") Then
Range("BR58:CA58").Select
Selection.Copy
Range(iRange2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If

Next iCell

End Sub
excel

2 respostas

  1. Best Answer

    Não tenho certeza se entendi direito, mas se você quiser alterar esse código:

    If Range("B9") = Range("BT28") Then
Range("BR58:CA58").Select
Selection.Copy
Range("BG9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If

    para que mude (B9, BG9) para (B10,BG10) e depois para (B11, BG11) até (B500, BG500), então talvez esse código o satisfaça:

    For Each cell In ActiveSheet.Range("BG9:BG500")
    If Range("B" & cell.Row) = Range("BT28") Then ActiveSheet.Range("BR58:CA58").Copy cell
Next cell

    Isso percorre Range("BG9:BG500") e altera as referências. Alterei seu método de copiar e colar, porque no VBA você não precisa selecionar as coisas. Em uma linha, você pode dizer ao VBA o que copiar e onde colar. A seleção de IMO é propensa a erros, apenas não é necessária e parece pior.
    Espero que ajude.

    • 1

  2. Se você quiser usar a mesma linha, use o .Rowda célula, ou você pode iterar em um loop for e usar Range("B" & i)com i sendo a iteração da linha.

    Sub IMPORTTOLIST()

    Dim iCell As Range, rng As Range, rngCopy As Range
    Application.ScreenUpdating = False
    Set rng = Range("B9:B500")
    Set rngCopy = Range("BR58:CA58")
    
    For Each iCell In rng.Cells
        If iCell.Value = Range("BT28").Value Then
            rngCopy.Copy Range("BG" & iCell.Row)
        End If
    Next iCell
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

    Se você não quiser usar a área de transferência, pode usar a seguinte. Provavelmente não notará diferença no desempenho, mas é opcional, é claro :):

    Sub IMPORTTOLIST_VALUES()
    Dim iCell As Range, rng As Range, rngCopy As Range
    Application.ScreenUpdating = False
    Set rng = Range("B9:B500")
    Set rngCopy = Range("BR58:CA58")
    
    For Each iCell In rng.Cells
        If iCell.Value = Range("BT28").Value Then
            Range("BG" & iCell.Row).Resize(, rngCopy.Columns.Count).Value = rngCopy.Value
        End If
    Next iCell
    Application.ScreenUpdating = True
End Sub
    • 0

relate perguntas