Vba 需要excel宏才能根据多个条件进行搜索和复制

我正在尝试创建一个VBA宏，该宏将根据以下条件搜索行：

首先，它将在“名称”列中查找宏中指定的名称

如果找到名称，将继续检查“已提交”列，并检查提交日期是否在每周日期之间。（如日期介于2015年2月23日至2015年2月27日之间）

如果日期介于指定日期之间，则宏将根据活动名称对活动进行分组，并根据“小时”选项卡中的值添加小时数。 最后，将整个数据复制并粘贴到同一工作簿中的另一个工作表中

到目前为止，我只能搜索名称部分，作为VBA宏的新手，我完全不知道如何继续

到目前为止，我从昨天开始就可怜地想办法。请帮忙。我附上了我的代码，虽然我不知道它是否有用

Sub Demo()
    Dim rngCell As Range
    Dim lngLstRow As Long
    Dim strFruit() As String
    Dim intFruitMax As Integer

    intFruitMax = 3
    ReDim strFruit(1 To intFruitMax)

    strFruit(1) = "A"
    strFruit(2) = "B"
    strFruit(3) = "C"

    lngLstRow = ActiveSheet.UsedRange.Rows.Count

    For Each rngCell In Range("J2:J" & lngLstRow)
        For i = 1 To intFruitMax
            If strFruit(i) = rngCell.Value Then
                rngCell.EntireRow.Copy
                Sheets("Inventory").Select
                Range("A65536").End(xlUp).Offset(1, 0).Select
                Selection.PasteSpecial xlPasteValues
                Sheets("Sheet1").Select
            End If
        Next i
    Next
End Sub

---

我相信下面的几点会让你进步，尽管这不是一个完整的答案，因为你没有提供足够的信息。警告：我没有完全解释我的宏。查找我使用的语句的帮助，并尝试找出它们产生效果的原因。带着必要的问题回来，但是你能为自己做的越多，你就越能发展你的VBA知识

---

最好避免使用

ActiveSheet

和

UsedRange

，除非您确切知道自己在做什么

如果使用激活的工作表，则用户在启动宏时需要激活正确的工作表。有一天，您可能希望允许用户选择宏的目标工作表，但我怀疑这里的情况是否如此。如果可能的话，要明确。例如：

With Worksheets("New Data")

  .Range("A1").Values = "Date"

End With

上面我明确指定了我希望使用的工作表。当用户启动宏时，哪个工作表处于活动状态并不重要。如果我在六个月后回到宏，我就不必记住它在20个工作表中的哪一个上运行

Excel对

UsedRange

的定义并不总是程序员认为它的意思。在各种测试工作表上试用之前不要使用它。特别是，请尝试（1）使用值格式化范围外的单元格，（2）保留未使用的左列和顶行。尝试

Debug.Print.UsedRange.Address

。你会对你得到的一些范围感到惊讶

创建新工作簿。将值放入E4、C7和B10中。合并单元格F12和F13，并在合并区域中放置一个值。这些值是什么并不重要

将此宏复制到模块并运行它：

Option Explicit
Sub Test1()

  Dim ColFinal As Long
  Dim RowFinal As Long
  Dim RowFinalC As Long

  With Sheets("Sheet1")

    RowFinal = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlPrevious).Row
    ColFinal = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
                           SearchOrder:=xlByColumns, _
                           SearchDirection:=xlPrevious).Column

    RowFinalC = .Cells(Rows.Count, "C").End(xlUp).Row

  End With

  Debug.Print "ColFinal" = ColFinal
  Debug.Print "RowFinal" = RowFinal
  Debug.Print "RowFinalC" = RowFinalC

End Sub

输出将是：

ColFinal=5
RowFinal=12
RowFinalC=7

在大多数情况下，

Find

是查找工作表最后一行和/或列的最佳方法<代码>内容：=“*”表示查找任何内容。请注意，

SearchOrder

的值不同。工作表不是矩形并不重要；最后一行和最后一列不必是同一单元格

但是，没有一种方法可以在任何情况下找到最后一行或最后一列<代码>查找按列搜索时未“看到”合并的单元格。（警告，我使用的是旧版本的Excel，这可能已在您的版本中修复。）

您需要在J列中使用最后一个单元格。我查找C列中最后一行的方法可能是最简单的方法

---

考虑：

intFruitMax = 3
ReDim strFruit(1 To intFruitMax)

strFruit(1) = "A"
strFruit(2) = "B"
strFruit(3) = "C"

    For i = 1 To intFruitMax

    Next i

代码没有问题，但此宏显示了一种可能更方便的不同方法：

Sub Test2()

  Dim Fruit() As Variant
  Dim InxFruit As Long

  Fruit = Array("A", "B", "C")

  For InxFruit = LBound(Fruit) To UBound(Fruit)
    Debug.Print Fruit(InxFruit)
  Next

End Sub

使用三个字母的前缀指定变量的类型已变得不常见。正如有人问的：“strFruit真的比水果更有用吗？”。避免使用变量名，如

i

。对于这样一个小的宏，这可能无关紧要，但我已经尝试用一堆毫无意义的名称来破译宏，我可以向你保证这是一场噩梦

InxFruit

表示这是数组水果的索引。我可以查看几年前编写的宏，立即知道所有变量是什么

LBound（Fruit）

如果使用

数组，则始终为零。还要注意，
水果
必须是
变体
类型。优点是，当您想要添加水果D和E时，您只需更改为：

 Fruit = Array("A", "B", "C", "D", "E")


如果找到名称，将继续检查“已提交”列，并检查提交日期是否在每周日期之间。（如日期介于2015年2月23日至2015年2月27日之间）

你为有趣的水果找行的技术不是最好的技术，但我认为它已经足够好了。我给了你们足够的思考，而不必讨论其他方法

我猜你想知道日期是否在本周的周一到周五之间

Now（）
提供当前日期和时间。下一个宏显示如何计算一周中任何一天的星期一和星期五。如果您选择复制此技术，请正确记录它，以使可怜的sod受益，他们必须在一年内更新您的宏。这个宏是所有聪明的算术函数和常数。我不喜欢聪明的代码，除非它有适当的文档记录，因为它通常是程序员炫耀而不是用最简单的方法解决问题

Sub Test3()

  Dim Friday As Date
  Dim InxDate As Long
  Dim Monday As Date
  Dim TestDates() As Variant
  Dim Today As Date
  Dim TodayDoW As Long

  TestDates = Array(DateSerial(2015, 2, 22), DateSerial(2015, 2, 23), _
                    DateSerial(2015, 2, 24), DateSerial(2015, 2, 25), _
                    DateSerial(2015, 2, 26), DateSerial(2015, 2, 27), _
                    DateSerial(2015, 2, 28), Now())

  For InxDate = 0 To UBound(TestDates)
    Today = TestDates(InxDate)
    TodayDoW = Weekday(Today)
    Monday = DateSerial(Year(Today), Month(Today), Day(Today) + vbMonday - TodayDoW)
    Friday = DateSerial(Year(Today), Month(Today), Day(Today) + vbFriday - TodayDoW)

    Debug.Print "Today=" & Format(Today, "ddd d mmm yy") & _
                "  Monday=" & Format(Monday, "ddd d mmm yy") & _
                "  Friday=" & Format(Friday, "ddd d mmm yy")
  Next

End Sub

请注意，Excel将日期保存为数字，因此您可以编写
。如果周一感谢@Tony的回答，我将尝试使用适当的文档自行创建宏。还有一件事是我在问题中提出的第三个条件。。也就是说，在名称和日期之后，我希望根据活动进行搜索并将它们分组，并添加相应值的hourse数。谢谢@JayantSharma你没有解释s中的条件3
Sub Test3()

  Dim Friday As Date
  Dim InxDate As Long
  Dim Monday As Date
  Dim TestDates() As Variant
  Dim Today As Date
  Dim TodayDoW As Long

  TestDates = Array(DateSerial(2015, 2, 22), DateSerial(2015, 2, 23), _
                    DateSerial(2015, 2, 24), DateSerial(2015, 2, 25), _
                    DateSerial(2015, 2, 26), DateSerial(2015, 2, 27), _
                    DateSerial(2015, 2, 28), Now())

  For InxDate = 0 To UBound(TestDates)
    Today = TestDates(InxDate)
    TodayDoW = Weekday(Today)
    Monday = DateSerial(Year(Today), Month(Today), Day(Today) + vbMonday - TodayDoW)
    Friday = DateSerial(Year(Today), Month(Today), Day(Today) + vbFriday - TodayDoW)

    Debug.Print "Today=" & Format(Today, "ddd d mmm yy") & _
                "  Monday=" & Format(Monday, "ddd d mmm yy") & _
                "  Friday=" & Format(Friday, "ddd d mmm yy")
  Next

End Sub

Sub Test4()

  ' I assume row 1 contains column headers and is not to be copied
  ' to the new worksheet.  Constants are a good way of making such
  ' assumptions explicit and easy to change if for example to add
  ' a second header row
  Const RowSht2DataFirst  As Long = 2   ' This only applies to Sheet2
  Const ColFruit As Long = 10           ' This applies to both sheets

  Dim Fruit() As Variant
  Dim FruitCrnt As String
  Dim InxFruit As Long
  Dim RowSht2Crnt As Long
  Dim RowSht2Last As Long
  Dim RowSht3Next As Long
  Dim Wsht2 As Worksheet
  Dim Wsht3 As Worksheet

  ' It takes VBA some time to evaluate Worksheets("Sheet2") and
  ' Worksheets("Sheet3").  This means it only has to do it once.
  Set Wsht2 = Worksheets("Sheet2")
  Set Wsht3 = Worksheets("Sheet3")
  ' BTW Please don't use the default names for a real workbook.
  ' It is so much easier to understand code with meaingful names

  Fruit = Array("A", "B", "C")

  With Wsht3
    ' Place new rows under any existing ones.
    RowSht3Next = .Cells(Rows.Count, ColFruit).End(xlUp).Row + 1
  End With

  With Wsht2

    RowSht2Last = .Cells(Rows.Count, ColFruit).End(xlUp).Row

      For RowSht2Crnt = RowSht2DataFirst To RowSht2Last
        FruitCrnt = UCase(.Cells(RowSht2Crnt, ColFruit).Value)
        For InxFruit = LBound(Fruit) To UBound(Fruit)
          If Fruit(InxFruit) = FruitCrnt Then
            .Rows(RowSht2Crnt).Copy Destination:=Wsht3.Cells(RowSht3Next, 1)
            RowSht3Next = RowSht3Next + 1
            Exit For
          End If  ' Match on fruit
        Next InxFruit
      Next RowSht2Crnt

  End With  ' Wsht3
End Sub