Excel 我的剧本演得不恰当

我有一个脚本来搜索列a中的“分析”并复制（0,2）并将其粘贴到每行的末尾，直到出现一个空白行。这在我的大多数团队中都很有效，但有一个团队的表现尤其不恰当

它按预期复制单元格，并仅将其粘贴到前两行。我不知道如何纠正它

以下是我的数据截图：

这是我正在使用的代码。我觉得这与行中有空格有关，但我不知道如何更正脚本

Sub AddDescriptive()
  Dim Assays as Range, Assay As Range, Group As Range, P As Range
  Set Assays = FindAll(Columns("A"),"Assay")
  If Assays Is Nothing Then
     Exit Sub
  End If

  'Visit each
  For Each Assay In Assays
  'Get the group
  Set Group = Assay.Offset(, 2)
  'Assign to column P
  Set P = Intersect(Assay.CurrentRegion.EntireRow, Columns("P"))
  'Write the group into column P
  P.Value = Group.Value
 Next
End Sub

Function FindAll(ByVal Where As Range, ByVal What, _
     Optional ByVal After As Variant, _
     Optional ByVal LookIn As XlFindLookIn = xlValues, _
     Optional ByVal LookAt As XlLookAt = xlWhole, _
     Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _
     Optional ByVal SearchDirection As XlSearchDirection = xlNext, _
     Optional ByVal MatchCase As Boolean = False, _
     Optional ByVal SearchFormat As Boolean = False) As Range
 'Find all occurrences of What in Where (Windows version)
  Dim FirstAddress As String
  Dim c As Range
 'From FastUnion:
  Dim Stack As New Collection
  Dim Temp() As Range, Item
  Dim i As Long, j As Long

 If Where Is Nothing Then Exit Function
 If SearchDirection = xlNext And IsMissing(After) Then
 'Set After to the last cell in Where to return the first cell in Where in 
   front if it match What
 Set c = Where.Areas(Where.Areas.Count)
'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet
'Set After = C.Cells(C.Cells.Count)
 Set After = c.Cells(c.Rows.Count * CDec(c.Columns.Count))
End If
 Set c = Where.find(What, After, LookIn, LookAt, SearchOrder, _
 SearchDirection, MatchCase, SearchFormat:=SearchFormat)
 If c Is Nothing Then Exit Function
 FirstAddress = c.Address
 Do
 Stack.Add c
 If SearchFormat Then
  'If you call this function from an UDF and _
    you find only the first cell use this instead
 Set c = Where.find(What, c, LookIn, LookAt, SearchOrder, _
    SearchDirection, MatchCase, SearchFormat:=SearchFormat)
Else
  If SearchDirection = xlNext Then
    Set c = Where.FindNext(c)
  Else
    Set c = Where.FindPrevious(c)
  End If
End If
'Can happen if we have merged cells
If c Is Nothing Then Exit Do
Loop Until FirstAddress = c.Address
'FastUnion algorithm © Andreas Killer, 2011:
'Get all cells as fragments
 ReDim Temp(0 To Stack.Count - 1)
 i = 0
 For Each Item In Stack
 Set Temp(i) = Item
 i = i + 1

Next
'Combine each fragment with the next one
j = 1
Do
For i = 0 To UBound(Temp) - j Step j * 2
  Set Temp(i) = Union(Temp(i), Temp(i + j))
Next
j = j * 2
Loop Until j > UBound(Temp)
'At this point we have all cells in the first fragment
Set FindAll = Temp(0)
End Function

---

您的问题不在于

FindAll

。（它只是返回a列中包含文本

“Assay”

的单元格的范围，因此可能返回范围

$a$2、$345、$1235、$1365

）

您的问题实际上是使用

Assay.CurrentRegion

，它将只返回包含

Assay

引用的单元格的当前区域，并且该区域的大小只有两行四列

根据屏幕截图中的数据，您似乎希望将值

“外观”

放入p列，从找到

“分析”

的行开始，在N列下一个空白单元格之前的行结束

这可以通过改变

  Set P = Intersect(Assay.CurrentRegion.EntireRow, Columns("P"))

将来

---

您是否已验证在单步执行代码时是否识别选定的预期区域？虽然屏幕截图有一点帮助，但它省略了一些信息，例如在第一次看到“40”之后a列中的内容（frmo是正确的示例）。看起来你的FindAll是基于连续的单元格，所以分析，CA，空格，CA，破坏了连续性。屏幕截图中“分析”单元格的

CurrentRegion

是2行4列宽，所以使用

CurrentRegion

是行不通的。在N列（和O列）的每个相关行中似乎都有数据。是否可以使用

范围（“P”和Assay.Row&“：P”和范围（“N”和（Assay.Row+1））.End（xlDown.Row）.Value=Group.Value

？就是这样！我在网上找到的FindAll函数被Assay、CA、space…CA之间的空格破坏了。有没有办法更正此代码？我可以分辨出小脚本，但这是一个庞然大物

FindAll

只是返回A列中包含

“分析”

的所有单个单元格。它根本不担心空白行。YowE3K，我不知道在哪里测试范围理论。你想用这个来代替什么？先生，你是一位学者和绅士。谢谢你的帮助。我确信问题出在FindAll函数中。很高兴我发帖了。

  Set P = Range("P" & Assay.Row & ":P" & Range("N" & (Assay.Row + 1)).End(xlDown).Row)