我遇到了障碍。我有一个文档获取审计项目的状态（圆，三角形，x）。目前，用户必须手动将问题写在另一个文档上。我想根据单元格中的选择自动填充其他文档。
在我的示例中，要查看的单元格字符串是V27：AD195。如果这些单元格中的任何一个包含“C”或“D”，那么它会将列“B”中的值返回到PFUS Sample文档的下一个可用空单元格。
我的编程想法让它无法正常工作......我不想/需要将整个行复制到B列中的单元格。
如何上传示例？ 我最初的编程想法是使用
Sub Sample()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim copyFrom As Range
Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
Dim strSearch As String
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("Test")
strSearch = "D"
With ws1
'~~> Remove any filters
.AutoFilterMode = False
'~~> I am assuming that the names are in Col A
'~~> if not then change A below to whatever column letter
lRow = .Range("E" & .Rows.Count).End(xlUp).Row
With .Range("E1:E" & lRow)
.AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With
'~~> Remove any filters
.AutoFilterMode = False
End With
'~~> Destination File
Set wb2 = Application.Workbooks.Open("C:\Sample.xlsx")
Set ws2 = wb2.Worksheets("Sheet1")
With ws2
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
copyFrom.Copy .Rows(lRow)
End With
wb2.Save
wb2.Close
End Sub
但是我无法操纵它以满足我的特定需求，因为它会复制整行。有任何想法吗？初学者VBA在这里知识有限，但可以快速拿起。
答案 0 :(得分：1)
您的代码问题
＆＃34; 在我的示例中，要查看的单元格字符串是V27：AD195。＆＃34;通过＆＃34;细胞串＆＃34;你的意思是＆＃34;细胞范围＆＃34;？您的代码在列E上执行自动筛选。这与V27:AD195？
你说你想要＆＃34; C＆＃34;或＆＃34; D＆＃34;但你只搜索＆＃34; D＆＃34;。
我很少使用AutoFilter而不是专家。对我来说，这似乎是一种不寻常的方法来搜索多列范围的多个值。您搜索=*D*。我的理解是你可以搜索特定的字符串，或空白或非空格。我不认为有一个外卡设施，我认为这是星号的目的。我不知道为什么平等就在那里。
如果您只对B栏感兴趣，为何选择Set copyFrom = ... EntireRow？
您有两个不同的要求。 （1）识别包含＆＃34; C＆＃34;的行。或＆＃34; D＆＃34;。 （2）将每行的B列的值移动到另一个工作表。在尝试达到要求2之前，您不会检查是否已成功达到要求1。
我对要求1的解决方案
StackOverflow上有很多答案显示如何将值从一个工作表移动到另一个工作表，因此我忽略了要求2.
要求1比较棘手，我没有看到类似的问题。
我不相信有AutoFilter达到要求1的任何明智方法。如果有人知道不同，我会有兴趣知道如何，因为这意味着我误解了AutoFilter的全部功能。
我本可以使用VBA来搜索单元格值，但我相信Find会在单元格中搜索字符串，但会更快。我没有测试过这个，但一般的建议是不要写VBA来复制Excel功能。键盘上有Find All，但没有等效的VBA。但是，我不相信VBA Find All在这种情况下会有所帮助。
我想对下面的代码说的第一件事就是它充满了Debug.Print个语句。我没有一次写这段代码。我逐步完成代码并使用Debug.Print语句检查每个部分是否完成了我想要的内容，然后再转到下一部分。还有很多Debug.Assert False，但其中一个已被注释掉。当我开始时，我在代码的每条路径的头部放置一个Debug.Assert False语句。当达到其中一个语句时，执行将停止。我踩上一条陈述，然后注释掉Debug.Assert False。如果在完成后仍有任何Debug.Assert False语句仍处于活动状态，或者我没有对我的代码进行充分测试，或者我的设计有问题并且无法访问代码。无论哪种方式，我还有更多工作要做。还有其他方法可以实现相同的目标，但这些技术对我有用。
您的代码必须查找＆＃34; C＆＃34;然后寻找＆＃34; D＆＃34;然后合并结果。在这种情况下使用搜索值数组比复制代码更容易，所以我有：
SearchValue = Array("C", "D", "Z", "G")
你只想要＆＃34; C＆＃34;和＆＃34; D＆＃34;但我想正确测试我的代码。在我的测试数据中没有＆＃34; Z＆＃34; s因此这个数组允许我测试完全没有值被正确处理。
我有两个其他数组（RowFirst和RowNext），我将其大小与SearchValue匹配。
我的测试数据是：
1 H I J K L M G
2 H I J D L M N
3 A B C K E F
4 H I J K L M N
5 O P Q R S T U
6 V W X Y X ABCDEF ABC
7 DEF AD A B E F G
8 H CAB ABD DEF L M N
9 C I J K L M N
10 H I J K L M N
11 H I D K L M N
12 H G J K L M N
13 H I G K L M N
14 H I J D L M N
15 H I J K L M N
16 H I J D L M N
第一个重要的代码块，搜索四个值的第一个匹配项并存储值以给出：
SearchValue "C" "D" "Z" "G"
RowFirst 3 2 0 1
RowNext 3 2 0 1
代码重复使用Find，最终会循环播放。当在主循环中，Find告诉我它已找到＆＃34; C＆＃34;在第3行（RowFirst中的值），我知道它已经循环并且每次出现＆＃34; C＆＃34;已被发现和处理。 ＆＃34; Z＆＃34; RowNext = 0列告诉代码不要查找＆＃34; Z＆＃34;
主循环首先处理刚找到的匹配。 RowNext中的最小值为1，因此这是具有这些值之一的下一个（第一个）行。我在数组RowMatch中记录1。
然后代码更新RowNext以获取包含第1行之后的搜索值的下一行。对于＆＃34; C＆＃34;和＆＃34; D＆＃34;，已经找到了下一行。没有搜索＆＃34; Z＆＃34;。下一个＆＃34; G＆＃34;在第7行。所以数组变为：
SearchValue "C" "D" "Z" "G"
RowFirst 3 2 0 1
RowNext 3 2 0 7
当Find循环时，该值的RowNext设置为0以指示该值已完成。主循环继续，直到所有RowNext值都为0.
对于我的测试数据，具有匹配值的行（存储在RowMatch中）是：
1 2 3 6 7 8 9 11 12 13 14 16
如果您的数据与我的数据相符，并且如果您对＆＃34; G＆＃34;感兴趣，则这些行的列B将移至新工作表。
我希望上面的解释，代码中的注释和Debug.Print语句的输出足以让您理解以下代码：
Option Explicit
Sub FindMatchingRows()
Dim ColRightToSearch As Long
Dim InxValueCrnt As Long
Dim InxMatchCrnt As Long
Dim InxMatchMax As Long
Dim RngMatch As Range
Dim RowBotToSearch As Long
Dim RngToSearch As Range
Dim RowFirst() As Long
Dim RowMatch() As Long
Dim RowNext() As Long
Dim RowFirstCrnt As Long
Dim SearchValue() As Variant
Dim WshtToSearch As Worksheet
' Specify search values
SearchValue = Array("C", "D", "Z", "G")
' Define worksheet and range to search. Change to your values
Set WshtToSearch = Worksheets("Sheet1")
Set RngToSearch = WshtToSearch.Range("A1:Z50")
' ReDim Preserve is a slow statement so I do not want to use it more often than
' necessary. When I do not know how many values I will want to store in an array I
' start with as many entries as I think will be enough and only enlarge the array
' if I fill it.
ReDim RowMatch(1 To 100)
InxMatchMax = 0 ' No rows with any of the values found yet
' One entry for each entry on SearchValue
' Search always start after the specified "after" cell, continues to the end of the
' range, loops to beginning of the range and continues to the "after" cell.
' RowFirst() is used to detect Find looping and finding the first row again.
' RowNext() records the most recent search.
ReDim RowFirst(LBound(SearchValue) To UBound(SearchValue))
ReDim RowNext(LBound(SearchValue) To UBound(SearchValue))
' Identify bottom range and rightmost column of range to be searched.
' See below for the use made of these values
RowBotToSearch = RngToSearch.Row + RngToSearch.Rows.Count - 1
ColRightToSearch = RngToSearch.Column + RngToSearch.Columns.Count - 1
Debug.Print "Bottom right cell is ("; RowBotToSearch & ", " & ColRightToSearch & ")"
' Initialise RowFirst and RowNext with the first row, if any, containing each
' search value. Each search must start after the bottom right cell of the search
' range so the search starts in the first cell of the range
RowFirstCrnt = 0 ' The first row containing any of the values
For InxValueCrnt = LBound(SearchValue) To UBound(SearchValue)
Set RngMatch = RngToSearch.Find(What:=SearchValue(InxValueCrnt), _
After:=WshtToSearch.Cells(RowBotToSearch, ColRightToSearch), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If RngMatch Is Nothing Then
' This value not found within range
'Debug.Assert False ' Not tested
Debug.Print SearchValue(InxValueCrnt) & " not found within range"
RowNext(InxValueCrnt) = 0
Else
' This value found within range
'Debug.Assert False ' Not tested
Debug.Print SearchValue(InxValueCrnt) & " found on row " & _
RngMatch.Row & " in column " & RngMatch.Column
RowNext(InxValueCrnt) = RngMatch.Row ' First row containing this value
RowFirst(InxValueCrnt) = RngMatch.Row
If RowFirstCrnt = 0 Then
' First value found so first row found with matching value
'Debug.Assert False ' Not tested
RowFirstCrnt = RngMatch.Row
ElseIf RowFirstCrnt > RngMatch.Row Then
' This value found on earlier row than previous best
'Debug.Assert False ' Not tested
RowFirstCrnt = RngMatch.Row
End If
End If
Next
Debug.Print "First rows: ";
For InxValueCrnt = LBound(SearchValue) To UBound(SearchValue)
If RowFirst(InxValueCrnt) = 0 Then
'Debug.Assert False ' Not tested
Debug.Print " " & SearchValue(InxValueCrnt) & " not found ";
Else
'Debug.Assert False ' Not tested
Debug.Print " " & SearchValue(InxValueCrnt) & " on row "; RowFirst(InxValueCrnt) & " ";
End If
Next
Debug.Print
Do While RowFirstCrnt > 0
Debug.Print "Next row with a match is " & RowFirstCrnt
' Record this match
InxMatchMax = InxMatchMax + 1
If UBound(RowMatch) < InxMatchMax Then
'Debug.Assert False ' Not tested
ReDim Preserve RowMatch(1 To 100 + UBound(RowMatch))
End If
RowMatch(InxMatchMax) = RowFirstCrnt
' Now look for further matches
RowFirstCrnt = 0 ' NO match found so far
For InxValueCrnt = LBound(SearchValue) To UBound(SearchValue)
If RowNext(InxValueCrnt) = 0 Then
' Either this value was not found or all occurrences of this value
' have already been found and recorded
'Debug.Assert False ' Not tested
ElseIf RowNext(InxValueCrnt) > RowMatch(InxMatchMax) Then
' The next occurrence of this value is after the most recent matching
' row so this is still the next occurrence of this value
If RowFirstCrnt = 0 Then
' Could be next matching row
'Debug.Assert False ' Not tested
Debug.Print "First possible next match " & SearchValue(InxValueCrnt) & _
" on row " & RowNext(InxValueCrnt)
RowFirstCrnt = RowNext(InxValueCrnt)
ElseIf RowFirstCrnt > RowNext(InxValueCrnt) Then
' This value found on earlier row than previous best
'Debug.Assert False ' Not tested
Debug.Print "New next match " & SearchValue(InxValueCrnt) & _
" on row " & RowNext(InxValueCrnt)
RowFirstCrnt = RowNext(InxValueCrnt)
End If
Else
'Debug.Assert False ' Not tested
' Need to search again starting at the end of RowMatch(inxMatchMax)
' Note I cannot use FindNext because it continues the most recent
' and this code is performing different Finds
Set RngMatch = RngToSearch.Find(What:=SearchValue(InxValueCrnt), _
After:=WshtToSearch.Cells(RowMatch(InxMatchMax), ColRightToSearch), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If RngMatch Is Nothing Then
' This should not be possible since we are only searching for value know to be present
Debug.Assert False ' Not tested
Else
'Debug.Assert False ' Not tested
Debug.Print SearchValue(InxValueCrnt) & " found on row " & _
RngMatch.Row & " in column " & RngMatch.Column
If RngMatch.Row = RowFirst(InxValueCrnt) Then
' Have looped back to first occurrence. All rows for this value
' found and recorded
'Debug.Assert False ' Not tested
RowNext(InxValueCrnt) = 0
Debug.Print SearchValue(InxValueCrnt) & " has looped"
Else
' New value found
'Debug.Assert False ' Not tested
RowNext(InxValueCrnt) = RngMatch.Row
If RowFirstCrnt = 0 Then
' First value found so first row found with matching value
'Debug.Assert False ' Not tested
RowFirstCrnt = RngMatch.Row
ElseIf RowFirstCrnt > RngMatch.Row Then
' This value found on earlier row than previous best
'Debug.Assert False ' Not tested
RowFirstCrnt = RngMatch.Row
End If
End If ' Process successful Find
End If ' Process result of Find
End If ' Decide if to search for this value
Next InxValueCrnt
Loop
Debug.Print "Rows with matching values:";
For InxMatchCrnt = 1 To InxMatchMax
Debug.Print " " & RowMatch(InxMatchCrnt);
Next
Debug.Print
End Sub