我已经成功地创建了一个基于日期列的新工作表,但是当我尝试通过添加位置来使其更具体时,它似乎不起作用。它运行正常,没有错误,但它只返回与日期指定的数据相同的数据,任何反馈都会有所帮助!
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
答案 0 :(得分:0)
问题是strLocation
未从Public Sub PromptUserForLocation()
传递回Public Sub PromptUserForInputDates()
。
一个简单的解决方案是将strLocations
InputBox
代码添加到Public Sub PromptUserForInputDates()
。
只需将Public Sub PromptUserForInputDates()
替换为以下内容:
我还在Date
中添加了Inputbox
格式的示例,这有助于用户输入正确的Excel数据进行处理。
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