☰

如何在单元格区域内搜索特定文本，然后复制到相邻单元格

tag-icon • tag-icon microsoft-excel-2010 worksheet-function vba
如何在单元格区域内搜索特定文本，然后复制到相邻单元格

我有一系列单元格，例如 g1-g1000，其中包含两种类型的条目：xx.xx 或 xx.xxCR，其中 xx.xx 是数字。

我想在单元格范围内搜索 xx.xxCR，当找到一个单元格时，将内容复制到减去 CR 的相邻单元格，然后删除原始单元格中的值。

包含 xx.xx 的单元格将不会进行任何操作。

例如，单元格 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

有人能发现我的错误吗？

答案1

我发现你的方法有几个错误，例如，不明确指定单元格和范围的位置以及使用 都被认为是不好的做法.select。一些Select- 语句也是多余的，当你在代码中使用范围引用限定单元格时，你不需要选择单元格。虽然我会为你实际声明变量而鼓掌，但你也应该说明你将它们声明为什么。在这种情况下，要么Dim i as Long要么Dim i as Integer(第一个稍微好一点，原因很复杂）。

正如 DarkMoon 所提到的，您用于指定范围的语法也是无效的，尽管您可以实现您想要做的事情，例如Range("G"&CStr(i))我真的建议您至少首先包含您正在使用的电子表格。即Worksheets("Sheet1").Range("G"&CStr(i))

以下是我解决您尝试执行的操作的方法，并对不同代码段的功能做了一些注释。您会注意到，我没有包含代码中的消息框，如果您的点击次数超过 1000 行，我敢打赌您不会想点击该“确定”按钮超过几百次 ;)

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

相关内容