您好我正在整理大量数据,总计大约340,000行。最终几乎每排都会按照某种方式进行按摩。我在第1步遇到问题,排序数据。
我会手动将数据分成不同的工作表。然后,我将运行一个宏,并将发生以下情况:提示将询问用户要搜索的内容,即。 “TEXT”然后询问用户要搜索哪个列,即。 “H”。然后,宏将满足上述内容的整行复制到新工作簿中,并自动将工作簿保存为.csv文件,提示用户输入名称。新工作簿可能有几百个匹配,因此必须将该行附加到下一个。当然我是新手,我使用过其他人的代码和我自己的代码。
以下代码已结束。我有以下问题:
我无法弄清楚如何手动输入回到sheetX继续搜索。我希望这是当前工作表或使用当前已注释掉的用户提示。
我可以将它移到新的工作表中,但如上所述,它希望它成为新的工作簿。
谢谢!
Public strData2 As String
Public strSearchSheet As String
Public strRange2 As String
Sub NewSearch()
'User Prompt box to enter IO driver type
strData2 = InputBox(Prompt:="Enter IO Driver type you wish to search. (IE GE9).", _
Title:="ENTER TYPE", Default:="Type here")
'strSearchSheet = InputBox(Prompt:="Enter Sheet name to search. (IE AI).", _
Title:="ENTER TYPE", Default:="Type here")
'User Prompt box to enter Column to search
strRange2 = InputBox(Prompt:="Enter Column you wish to search. (IE E).", _
Title:="ENTER TYPE", Default:="Type here")
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
'On Error GoTo Err_Execute
'Start search in row 1
LSearchRow = 1
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column = "TEXT", copy entire row to Sheet2
If Range(strRange2 & CStr(LSearchRow)).Value = strData2 Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Test").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("AO").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
答案 0 :(得分:0)
使用.Select
是您的罪魁祸首。如果您不选择其他工作表,则无需保存您的职位。请参阅this,了解Select
不是一个好主意的绝佳理由。
整个代码块:
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Test").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
可以放在一个不会丢失位置的行中
'Copy from row LSearchrow to LCopyToRow in Test sheet
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy _
Sheeets("Test").Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow))
(分为2行以便于阅读)这不会改变工作表,所以搜索时你的地方不会丢失
如果要创建新工作簿,则Workbooks.Add
将添加新工作簿。如果将新工作簿分配给变量,则可以使用可在当前工作簿上使用的相同命令对其进行操作。
e.g。
Dim NewWS As Workbook
Set NewWS = Workbooks.Add
NewWS.Sheets("Sheet1").Range("A1").Value = 3
NewWS.SaveAs "myFilename.csv", xlCSV
NewWS.Close