Как найти диапазон ячеек для конкретного текста, а затем скопировать в соседнюю ячейку

Question

У меня есть диапазон ячеек, например, g1-g1000, который содержит записи двух типов: xx.xx или xx.xxCR, где xx.xx - числа.

Я хочу найти диапазон ячеек для xx.xxCR и, когда ячейка найдена, скопировать содержимое в соседнюю ячейку минус CR, а затем удалить значение в исходной ячейке.

Клетки, которые содержат xx.xx, не будут делать с ними ничего.

EG клетка g5 содержит 23,67CR; после запуска алгоритма ячейка h5 содержит 23,67, а g5 пуст.

Сделайте это для диапазона значений в g0-g1000

Вот моя попытка:

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  

Я продолжаю получать ошибку времени выполнения 1004 Application defined or object defined error at the line:Range(Cells(i, "G")).Select

Может кто-то заметит ошибку моих путей?

Answer 1

Я вижу несколько ошибок на вашем пути, например, считается плохой практикой не указывать, где ваши ячейки и диапазоны расположены более явно, чем вы, и использовать .select . Некоторые из операторов Select также излишни, вам не нужно выбирать ячейку, когда вы определяете ее с помощью ссылки на диапазон в вашем коде. И хотя я буду аплодировать вам за фактическое объявление ваших переменных, вы также должны сказать, как вы их объявляете. В этом случае либо Dim i as Long либо Dim i as Integer (первый вариант немного лучше по сложным причинам).

Синтаксис, который вы используете для указания диапазонов, также недействителен, как упоминает DarkMoon, и хотя вы могли бы достичь чего-то вроде того, что вы хотите делать, например Range("G"&CStr(i)) я действительно призываю вас включить хотя бы какую таблицу на первом. Т.е. Worksheets("Sheet1").Range("G"&CStr(i))

Вот как я бы решил, что вы пытаетесь сделать, с несколькими комментариями о том, что делают разные куски кода. Вы заметите, что я не включил окно сообщения, которое есть в вашем коде, на случай, если вы получите много попаданий по 1000 строкам, держу пари, что вы не хотите нажимать эту кнопку OK несколько раз ;)

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