Question

我已经成功地创建了一个基于日期列的新工作表，但是当我尝试通过添加位置来使其更具体时，它似乎不起作用。它运行正常，没有错误，但它只返回与日期指定的数据相同的数据，任何反馈都会有所帮助！

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()。

一个简单的解决方案是将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

基于2列创建新工作表

1 个答案: