基于search标准提取行
我的问题是，我想从一个非常大的数据表中提取一些信息。 正在提取的信息是基于一些表单上input的search条件。 search表单计算出这个标准存在多less次，但是我需要将单个行提取到另一个表单中。
我很难理解如何实际构造提取代码。 我需要指出正确的方向。 如果代码可以计算有多less事件，那么当然我可以得到这些事件的行号，并提取信息，我只是没有得到任何解决办法。
这里是我的search代码（这个代码用于根据所要求的标准得到出现次数）
Public Sub Run_Count_Click() '// Set Ranges Dim Cr_1, CR1_range, _ Cr_2, CR2_range, _ Cr_3, CR3_range, _ Cr_4, CR4_range, _ Cr_5, CR5_range _ As Range '// Set Integers Dim CR1, V1, CR1_Result, _ CR2, V2, CR2_Result, _ CR3, V3, CR3_Result, _ CR4, V4, CR4_Result, _ CR5, V5, CR5_Result, _ total_result, _ total_result2, _ total_result3, _ total_result4, _ total_result5 _ As Integer 'Set Strings Dim V_1, V_2, V_3, V_4, V_5 As String Dim ws As Worksheet Set ws = Worksheets("database") Sheets("Settings").Range("Start_Date").Value = Format(Me.R_Start.Value, "mm/dd/yyyy") Sheets("Settings").Range("End_Date").Value = Format(Me.R_End.Value, "mm/dd/yyyy") 'Collect Start & End Dates Dim dStartDate As Long Dim dEndDate As Long dStartDate = Sheets("Settings").Range("Start_Date").Value dEndDate = Sheets("Settings").Range("End_Date").Value ws.Activate On Error GoTo error_Sdate: Dim RowNum As Variant RowNum = Application.WorksheetFunction.Match(dStartDate, Range("B1:B60000"), 0) 'MsgBox "Found " & Format(dStartDate, "dd/mm/yyyy") & " at row : " & RowNum On Error GoTo error_Edate: Dim RowNumEnd As Variant RowNumEnd = Application.WorksheetFunction.Match(dEndDate, Range("B1:B60000"), 1) ' MsgBox "Found " & Format(dEndDate, "dd/mm/yyyy") & " at row : " & RowNumEnd GoTo J1 error_Sdate: Dim msg As String msg = "You entered " & Format(dStartDate, "dd/mm/yyyy") & " as your Start Date, but no referrals were made on that date" msg = msg & vbCrLf & "Please enter a different date in the Start Date box" MsgBox msg, , "Start Date Not Found" Err.Clear Exit Sub error_Edate: msg = "You entered " & Format(dEndDate, "dd/mm/yyyy") & " as your End Date, but no referrals were made on that date" msg = msg & vbCrLf & "Please enter a different date in the End Date box" MsgBox msg, , "End Date Not Found" Err.Clear Exit Sub J1: '// Get Criteria From Form And Search Database Headers Set Cr_1 = ws.Cells.Find(What:=Me.Count_Criteria_1.Value, After:=ws.Cells(1, 1), MatchCase:=False) If Not Cr_1 Is Nothing Then CR1 = Cr_1.Column '//Set CR1 as the Column in which the Criteria Header was found Else MsgBox "Criteria 1 Has Not Been Found In The Database. Report Has Failed To Generate" Exit Sub End If '// Get Variable Value From Form And Set Shortcode V_1 = Me.Criteria_1_Variable.Value Set CR1_range = ws.Range(ws.Cells(RowNum, CR1), ws.Cells(RowNumEnd, CR1)) CR1_Result = Application.CountIf(CR1_range, V_1) Me.Count_Result.visible = True Me.Count_Result.Value = "Based On Your Search Criteria Of:" & vbNewLine & vbNewLine & _ "- " & Me.Count_Criteria_1.Value & ": " & Me.Criteria_1_Variable.Value & vbNewLine & vbNewLine & _ "The Results Are: " & CR1_Result & " entries found between the dates " & Format(dStartDate, "dd/mm/yyyy") & _ " and " & Format(dEndDate, "dd/mm/yyyy") Exit Sub 有循环做这个简单的方法吗？ 我知道循环不是处理事物的最佳方式，但我寻找任何有用的东西，我可以调整以适应我的需要。
谢谢，如果你能提前帮忙，这是一个电子表格的怪物！
—————————- * 更新与接受的答案： * ————— ————-
Public Sub Count_Extract_Click() 'Collect Information To Be Extracted Set ws = Worksheets("database") Set ps = Worksheets("Extracted Rows") ps.Range("A3:AM60000").Clear For i = RowNum To RowNumEnd If ws.Cells(i, CR1).Value = V_1 Then ws.Range("A" & i & ":AM" & i).Copy ps.Activate 'find first empty row in database emR = ps.Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1 ps.Range("A" & emR & ":AM" & emR).PasteSpecial End If Next i End If End Sub
你应该能够设置一个For循环来检查你find的范围内的每一个值，并将它复制到（另一个单元格，一个数组，无论你喜欢什么）。
For i = rowNum To rowNumEnd If Cells(i,CR1).Value = V_1 Then MsgBox "Found match on row " & i End If Next i
我没有testing过这个，但是应该可以。 让我知道，如果你有任何错误。
我真的不能试试，但也许可以。 保持行V_1 = Me.Criteria_1_Variable.Value但通过replace下面的2：
CR1_Result = 0 'Initiates counter at 0 Dim CR1_Lines(1000) As Long 'Declares an array of 1001 (indexes 0-1000) Longs (big integers) For x = RowNum To RowNumEnd 'Loops through all the rows of CR1 If ws.Cells(x, CR1) = V_1 Then 'Match! 'Double array size if capacity is reached If CR1_Result = UBound(CR1_Lines) Then ReDim Presrve CR1_Lines(UBound(CR1_Lines) * 2) End If 'Store that line number in the array CR1_Lines(CR1_Result) = x 'Increment count of matches CR1_Result = CR1_Result + 1 End If Next x 'Next row!
然后你可以通过这个代码循环访问数组：
For i = 0 to UBound(CR1_Lines) 'Do something! (Why not just an annoying pop-up box with the content!) MsgBox CR1_Lines(i) Next i
编辑：我刚刚读到，电子表格是mon，，重新确定每次发现新的匹配可能是整齐，但它是一个性能下降的地狱。 我在上面的代码中直接做了一些修改，使它更有效一些。
编辑＃2：我已经简化了代码，所以你没有任何事情要做，但复制粘贴（请原谅我不假设RowNum和RowNumEnd有有效的数据）。 它应该像接受的答案一样工作，但之前已经发布了一些内容，并且实际上展示了如何提取行号。 我知道如果你所需要的只是一个带有行号的popup框，并且会满意已经收到的upvote。