基于2列创build新的工作表

我已经成功地创build了基于date列的新工作表，但是当我尝试通过添加位置来使其更具体时，它似乎不工作。 它运行良好，没有错误，但它只是返回相同的数据，当时是由date指定，任何反馈将是有益的！

Option Explicit Public Sub PromptUserForInputDates() Dim strStart As String, strEnd As String, strPromptMessage As String Dim LastOccupiedRowNum As String, LastOccupiedColNum As String Dim strLocation As String strStart = InputBox("Please enter the start date") If Not IsDate(strStart) Then strPromptMessage = "Not Valid Date" MsgBox strPromptMessage Exit Sub End If strEnd = InputBox("Please enter the end date") If Not IsDate(strStart) Then strPromptMessage = "Not Valid Date" MsgBox strPromptMessage Exit Sub End If Call PromptUserForLocation Call CreateSubsetWorksheet(strStart, strEnd, strLocation) End Sub Public Sub PromptUserForLocation() Dim strLocation As String, strPromptMessage As String strLocation = InputBox("Please Enter the Location") Exit Sub End Sub Public Sub CreateSubsetWorksheet(StartDate As String, EndDate As String, Location As String) Dim wksData As Worksheet, wksTarget As Worksheet Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long Dim rngFull As Range, rngResult As Range, rngTarget As Range Dim lngLocationCol As Long Set wksData = ThisWorkbook.Worksheets("Sheet1") lngDateCol = 4 lngLocationCol = 21 lngLastRow = LastOccupiedRowNum(wksData) lngLastCol = LastOccupiedColNum(wksData) With wksData Set rngFull = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol)) End With With rngFull .AutoFilter Field:=lngDateCol, _ Criteria1:=">=" & StartDate, _ Criteria2:="<=" & EndDate _ With rngFull .AutoFilter Field:=lngLocationCol, _ Criteria1:=Location If wksData.AutoFilter.Range.Columns(1).SpecialCells (xlCellTypeVisible).Count = 1 Then MsgBox "Dates Filter out all data" wksData.AutoFilterMode = False If wksData.FilterMode = True Then wksData.ShowAllData End If Exit Sub Else Set rngResult = .SpecialCells(xlCellTypeVisible) Set wksTarget = ThisWorkbook.Worksheets.Add Set rngTarget = wksTarget.Cells(1, 1) rngResult.Copy Destination:=rngTarget End If End With End With wksData.AutoFilterMode = False If wksData.FilterMode = True Then wksData.ShowAllData End If MsgBox "Data Transferred" End Sub Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long Dim lng As Long If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then With Sheet lng = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row End With Else lng = 1 End If LastOccupiedRowNum = lng End Function Public Function LastOccupiedColNum(Sheet As Worksheet) As Long Dim lng As Long If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then With Sheet lng = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column End With Else lng = 1 End If LastOccupiedColNum = lng End Function 

Answer 1

问题是， strLocation不是从Public Sub PromptUserForLocation()传回到Public Sub PromptUserForInputDates() 。

一个简单的解决scheme是将strLocations InputBox代码添加到Public Sub PromptUserForInputDates() 。

只需将您的Public Sub PromptUserForInputDates()replace为以下内容：

我还添加了一个包含在inputInputbox的Date格式的Inputbox ，这将有助于用户inputExcel正确的数据进行处理。

 Public Sub PromptUserForInputDates() Dim strStart As String, strEnd As String, strPromptMessage As String Dim LastOccupiedRowNum As String, LastOccupiedColNum As String Dim strLocation As String strStart = InputBox("Please enter the start date" & _ vbCr & _ vbCr & _ "Example: 2016/01/01") If Not IsDate(strStart) Then strPromptMessage = "Not Valid Date" MsgBox strPromptMessage Exit Sub End If strEnd = InputBox("Please enter the end date" & _ vbCr & _ vbCr & _ "Example: 2016/01/10") If Not IsDate(strStart) Then strPromptMessage = "Not Valid Date" MsgBox strPromptMessage Exit Sub End If strLocation = InputBox("Please Enter the Location") If strLocation = Empty Then strPromptMessage = "Please enter a location." MsgBox strPromptMessage Exit Sub End If Call CreateSubsetWorksheet(strStart, strEnd, strLocation) End Sub