VBA：Simple Date宏不起作用 [英] VBA: Simple Date Macro that does not work

问题描述

我有两个文本框，其中两个日期分别在两个框中键入。我希望宏经过一段日期，并在文本框中输入的两个日期之间隐藏不的所有日期。第一个文本框的日期应该是过去的第二个文本框的日期。

我有以下代码：

 设置ws2 = Sheets（Test）
 
 Dim StartDate As String 
 Dim EndDate As String 
 
 ws2.Range（G2）Value = TXTDate1.Text 
 ws2.Range（G3）。Value = TXTDate2.Text 
 
 StartDate = ws2.Range（G2） $ value 
 EndDate = ws2.Range（G3）值
 
 StartDate = Trim（ws2.Range（G2）。值）
 EndDate = Trim（ws2.Range（G3）。Value）**'将美国日期格式的格式转换为英文日期格式** 
 
设置temprange = ActiveSheet.Range（D5 ）.End（xlDown）
设置temprange =范围（范围（D6），temprange）
 
 
对于每个z在temprange 
 
 z .EntireRow.Hidden = True 
 
如果TXTDate1.Value<> 然后
 
如果z.Offset（0，5）.Value> StartDate然后
 
如果z.Offset（0，5）.Value< EndDate然后**'部分不工作** 
 
 z.EntireRow.Hidden = False 
 
结束如果
 
结束如果
 
结束如果
 
下一个z 
  

问题是第二个条件不行。宏不会识别结束日期之前的日期。如何启用宏来识别第二个条件？

解决方案

我使用了 AutoFilter方法根据您的 startdate 和 enddate 显示/隐藏日期/ em> vars。

  Sub hide_dates（）
 Dim ws2 As Worksheet，tempRange As Range 
 Dim StartDate As String 
 Dim EndDate As String 
 
设置ws2 = Sheets（Test）
 ws2.Range（G2）。Value = TXTDate1.Text 
 ws2.Range（G3）。值= TXTDate2.Text 
 
 StartDate =格式（DateValue（ws2.Range（G2）。值），mm / dd / yyyy）
 EndDate = Format（DateValue（ws2.Range（G3）。Value），mm / dd / yyyy）
 
使用ActiveSheet 
如果.AutoFilterMode然后.AutoFilterMode = False 
设置tempRange = .Range（.Range（D5），.Range（D5）。End（xlDown））
使用tempRange 
 .AutoFilter字段：= 1，Criteria1： => =& StartDate，_ 
运算符：= xlAnd，Criteria2：=< =& EndDate，_ 
 VisibleDropDown：= False 
结束
结束
 
 End Sub 
  

我隐藏了通常与.AutoFilter关联的小下拉箭头。您必须将格式掩码更改为EN-UK格式以匹配您的数据（d / m / yy ...？）。

行可以是通过常规手段或通过使用数据上的清除命令来取消隐藏►排序&过滤或简单地关闭.AutoFilter。

I have two text boxes with for two dates to be typed in both boxes respectively. I want the macro to go through a column of dates and hide all dates that are not in between the two dates typed in the text boxes. The first text box date should be further in the past then the second text box date.

I have the following code:

Set ws2 = Sheets("Test")

Dim StartDate As String
Dim EndDate As String

ws2.Range("G2").Value = TXTDate1.Text
ws2.Range("G3").Value = TXTDate2.Text

StartDate = ws2.Range("G2").Value ' Start Date in  test tab
EndDate = ws2.Range("G3").Value

StartDate = Trim(ws2.Range("G2").Value)
EndDate = Trim(ws2.Range("G3").Value) **'Reverses the format from American date format to English date format**

Set temprange = ActiveSheet.Range("D5").End(xlDown)
Set temprange = Range(Range("D6"), temprange)


For Each z In temprange

z.EntireRow.Hidden = True

If TXTDate1.Value <> "" Then

If z.Offset(0, 5).Value > StartDate Then

If  z.Offset(0, 5).Value < EndDate Then **'PART THAT IS NOT WORKING**

z.EntireRow.Hidden = False

End If

End If

End If

Next z

The problem is the second condition is not working. The macro is not recognising dates that are before the End date. How do I enable the macro to recognise the 2nd Condition?

解决方案

I've used the AutoFilter Method to show/hide the dates based upon your startdate and enddate vars.

Sub hide_dates()
    Dim ws2 As Worksheet, tempRange As Range
    Dim StartDate As String
    Dim EndDate As String

    Set ws2 = Sheets("Test")
    ws2.Range("G2").Value = TXTDate1.Text
    ws2.Range("G3").Value = TXTDate2.Text

    StartDate = Format(DateValue(ws2.Range("G2").Value), "mm/dd/yyyy")
    EndDate = Format(DateValue(ws2.Range("G3").Value), "mm/dd/yyyy")

    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        Set tempRange = .Range(.Range("D5"), .Range("D5").End(xlDown))
        With tempRange
            .AutoFilter field:=1, Criteria1:=">=" & StartDate, _
                 Operator:=xlAnd, Criteria2:="<=" & EndDate, _
                 VisibleDropDown:=False
        End With
    End With

End Sub

I've hidden the small drop-down arrow normally associated with an .AutoFilter. You will have to change the format masks to a EN-UK format to match your data (d/m/yy...?).

The rows can be 'unhidden' through conventional means or by using the Clear command on Data ► Sort & Filter or simply turning the .AutoFilter off.

这篇关于VBA：Simple Date宏不起作用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！