2つの列に基づいて新しいシートを作成する

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 PromptUserForInputDates()にPublic Sub PromptUserForLocation()から渡されていないことです。

strLocationsInputBoxコードをPublic Sub PromptUserForInputDates()に追加するだけです。

ただ、次のようにあなたのPublic Sub PromptUserForInputDates()を置き換える：

を私はまた、Excelが処理するために、これは、ユーザー入力に正しいデータを助ける、Inputboxに含まれるDateフォーマットのための例を追加しました。

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