Question

我有一系列输入，如图1所示。如果我在另一张纸上给出开始日期和结束日期，vba将会运行，我需要获得输出，如图2所示。我可以指定任何日期作为下一张表中的日期范围。输入范围内存在重复日期。如何为此方案提供日期循环并删除名称中的重复项以添加时间并获得所需的输出。

`

Sub dateloop()

Dim sd As Date
Dim ed As Date
Dim asd As Range

sd = Sheets(1).Range("b2") .Value
ed = Sheets(1).Range("b3").Value

For asd = sd To ed
MsgBox asd.Value
Next asd

End Sub    `

我尝试了上面的代码，但它没有遍历日期范围。

Sub looprange()   
Dim MyRange As Range
Dim MyCell As Range

Set MyRange = Sheets("input").Range("A1:a40000")


For Each MyCell In MyRange

  If MyCell.Value >= Sheets("output").Range("b2").Value And _
  MyCell.Value <= Sheets("output").Range("b3").Value Then

  Sheets("output").Range("b5").offset(1,0) = Mycell.offset(0,1).Value

    End If


  Next x
End Sub

我尝试过以上编码，但我没有工作。有人可以帮助我获得输出。

输入：

输出：

Answer 1

根据两个标准组合唯一值

守则

Option Explicit
'Option Explicit is very helpful because it will throw an error on compile if
'you have undefined variables floating around in your project.

Sub LoopRange()
Application.ScreenUpdating = False 'Faster runtime

Dim iWS As Worksheet: Set iWS = ThisWorkbook.Sheets("Input")
Dim oWS As Worksheet: Set oWS = ThisWorkbook.Sheets("Output")

Dim inputRange As Range: Set inputRange = iWS.Range("A3", iWS.Range("A3").End(xlDown))
Dim outputRange As Range: Set outputRange = oWS.Range("A6", oWS.Range("A6").End(xlDown))
Dim fullOpRange As Range

Dim startDate As Date: startDate = oWS.Range("B2").Value
Dim endDate As Date: endDate = oWS.Range("B3").Value

Dim cRow As Long: cRow = 5
Dim oRow As Long: oRow = 7
Dim iCell As Range, oCell As Range

'Build the output range on the Output worksheet that falls between defined dates.
For Each iCell In inputRange
    If iCell.Value >= startDate And iCell.Value <= endDate Then
        cRow = cRow + 1
        oWS.Range("A" & cRow).Value = iCell.Offset(0, 1).Value
        oWS.Range("B" & cRow).Value = iCell.Offset(0, 2).Value
        oWS.Range("C" & cRow).Value = iCell.Offset(0, 3).Value
    End If
Next iCell

Set fullOpRange = oWS.Range("A5:C" & oWS.Cells(Rows.Count, 3).End(xlUp).Row)

'Sort the output range
fullOpRange.Sort oWS.Range("A6"), xlAscending, oWS.Range("B6"), , xlAscending, Header:=xlYes
fullOpRange.Borders.LineStyle = xlContinuous

'Add duplicate matching Name/Type and delete excess
Do
    If oWS.Range("A" & oRow).Value = oWS.Range("A" & oRow - 1).Value And oWS.Range("B" & oRow).Value = oWS.Range("B" & oRow - 1).Value Then
        oWS.Range("C" & oRow - 1).Value = oWS.Range("C" & oRow - 1).Value + oWS.Range("C" & oRow).Value
        oWS.Range("A" & oRow).EntireRow.Delete xlUp
    Else
        oRow = oRow + 1
    End If
Loop While oRow <> oWS.Cells(Rows.Count, 3).End(xlUp).Row + 1

Application.ScreenUpdating = True 'Do not forget to turn this back on!
End Sub

<强>解释

我做的第一件事就是将所需日期之间的适用数据从输入工作表传输到输出工作表。

接下来，我想按名称和类型对这些数据进行排序，以便更快地在输出范围内循环。

之后，它就像将当前行的数据与前一行比较一样简单，然后循环到最后。

带迷你答案的评论

上面的代码应该按照你想要的方式运行。这个代码的扩展空间更大，使其在多种用途中更加用户友好，但我会留给您。看起来您可能没有掌握基础知识，如果这是真的，我强烈建议您阅读一些涵盖您想要使用的表达式的教程。如果您能够很好地理解基本的编程表达式，它将为您节省大量时间和头痛。

例如，您说以下代码没有遍历您的日期范围。我添加了评论，以帮助您了解为什么这不适用于For Loop的结构：

Sub dateloop()

    Dim sd As Date
    Dim ed As Date
    Dim asd As Range

    sd = Sheets(1).Range("b2").Value
    ed = Sheets(1).Range("b3").Value

    For asd = sd To ed     'For Range = Date To Date
        MsgBox asd.Value   'MsgBox Range.Value (Range was never defined)
    Next asd               'Next Range

End Sub

您尝试使用For Loop的方式不正确。以下代码可以，但并不能帮助您实现最终目标：

Sub dateloop()

    Dim sd As Date
    Dim ed As Date
    Dim asd As Date '<----Date

    sd = Sheets(2).Range("b2").Value
    ed = Sheets(2).Range("b3").Value

    For asd = sd To ed 'For Date = Date To Date
        MsgBox asd '<----remove .Value
    Next asd

End Sub

采用对您的项目更有用的For Loop的另一种方式：

Sub dateloop()

    Dim sd As Date
    Dim ed As Date
    Dim asd As Range '<----Range

    sd = Sheets(2).Range("b2").Value
    ed = Sheets(2).Range("b3").Value

    For Each asd In Sheets(1).Range("A3:A20") 'For Each Range in Range
        If asd.Value >= sd And asd.Value <= ed Then _
            MsgBox asd.Value
    Next asd

End Sub

我希望这会有所帮助。如果您对我提供的代码正在做什么有任何疑问，或者如果有任何问题，请告诉我。祝你好运！

循环遍历日期范围并添加相应的单元格输入

1 个答案:

根据两个标准组合唯一值