Como pesquisar um intervalo de células para um texto específico, copie para uma célula adjacente

Question

Eu tenho um intervalo de células, por exemplo g1-g1000 que contém dois tipos de entradas: xx.xx ou xx.xxCR, em que xx.xx são números.

Eu quero pesquisar o intervalo de células para xx.xxCR e quando uma célula é encontrada, copie o conteúdo para a célula adjacente menos o CR, em seguida, exclua o valor na célula original.

Células que contêm xx.xx não farão nada a elas.

E.G. célula g5 contém 23,67CR; depois de executar o algorighm, a célula h5 contém 23.67 e g5 está vazia.

Faça isso para o intervalo de valores em g0-g1000

Aqui está minha tentativa:

Dim i
 For i = 1 To 30  
 If InStr(UCase(Cells(i, "G")), "CR") Then  
 MsgBox "The string 'CR' was found in cell " & Cells(i, "G").Address(0, 0)  
 ' Copy the cell containing xx.xxCR to the adjacent cell  
 Range(Cells(i, "G")).Select  
 Range(Cells(i, "G")).Copy  
 Range(Cells(i, "H")).Select  
 ActiveSheet.Paste  
 ' Remove the CR from the adjacent cell e.g. "C", just leaving xx.xx  
 Cells(i, "H") = WorksheetFunction.Substitute(Cells(i, "H"), "CR", "")  
 'Remove the contents of the cell where CR was found  
 '?? what should go here?  
 End If  
 Next  

Continuo recebendo erro de execução 1004 Application defined or object defined error at the line:Range(Cells(i, "G")).Select

Alguém consegue identificar o erro dos meus caminhos?

    

Answer 1

Eu vejo vários erros em seus caminhos, por exemplo, é considerado uma má prática não especificar onde suas células e intervalos estão localizados mais explicitamente do que você e usar .select . Algumas das Select -statements também são supérfluas, você não precisa selecionar a célula ao qualificá-la com uma referência de intervalo em seu código. E enquanto eu te aplaudo por realmente declarar suas variáveis, você também deve dizer o que você declara. Nesse caso, Dim i as Long ou Dim i as Integer ( o primeiro é um pouco melhor para razões complicadas ).

A sintaxe que você usa para especificar intervalos também é inválida, como menciona o DarkMoon, e embora você possa ter alcançado algo parecido com o que deseja fazer, por exemplo, Range("G"&CStr(i)) Eu realmente gostaria que você incluísse pelo menos a planilha na qual você está. Ou seja Worksheets("Sheet1").Range("G"&CStr(i))

Aqui está como eu resolveria o que você está tentando fazer, com alguns comentários sobre o que os diferentes bits de código fazem. Você notará que eu não incluí o messagebox que está no seu código, no caso de você ter muitos acessos nas 1000 linhas, eu aposto que você não quer clicar no botão OK mais do que umas 100 vezes. ;)

Option Explicit

Sub test()
  Dim range_to_search As Range, string_to_find  As String, found_cell As Range, first_address As String

  ' Turn off a couple  of settings to make the code run faster
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.DisplayStatusBar = False
  Application.Calculation = xlCalculationManual

  ' Set the value to search for, and the range to search in
  string_to_find = "CR"
  Set range_to_search = Worksheets("Sheet1").Range("G1:G1000")

  ' Find the first cell in the range containing the searchstring
  Set found_cell = range_to_search.Find(What:=string_to_find, After:=range_to_search(range_to_search.CountLarge, 1), LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
  ' No point in doing anything if no cell containing the string is found
  If Not found_cell Is Nothing Then
    ' This isn't strictly necessary since we clear the cells as we go along, but at the end of the macro, we'll use this string to make sure we don't loop over the range again  and again
    first_address = found_cell.Address
    ' Start of loop
    Do
      ' Replace the string we're searching for with a zero-length string
      found_cell = Replace(found_cell, string_to_find, "", 1, -1, vbTextCompare)
      ' Copy the edited value to the adjacent column
      found_cell.Copy Destination:=found_cell.Offset(0, 1)
      ' Clear the cell
      found_cell.ClearContents
      ' Find a possible next value
      Set found_cell = range_to_search.FindNext(found_cell)
      ' If we haven't found a new cell containing the searchstring, we exit the loop
      If found_cell Is Nothing Then Exit Do
    ' Have we reached the top again? If not, keep looping.
    Loop While found_cell.Address <> first_address
  End If

  ' Turn the settings back on
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.DisplayStatusBar = True
  Application.Calculation = xlCalculationAutomatic
End Sub