Question

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

首先，它会在名称列中查找宏中指定的名称。
如果找到该名称，它将继续检查“已提交”列并检查提交的日期是否在每周日期之间。（如果日期在2月23日/ 2015-2 / 27/2015之间）。
如果日期位于指定日期之间，则宏将根据其名称对活动进行分组，并根据小时选项卡中的值添加小时数。这整个数据最终将被复制并粘贴到同一工作簿中的另一个工作表中。

到目前为止，我只能搜索名称部分并成为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

Answer 1

我相信以下几点可以让你进步，虽然它不能是一个完整的答案，因为你没有提供足够的信息。警告：我没有完全解释我的宏。查找我使用的语句的帮助，并尝试找出他们为什么会有这样的效果。尽可能回答问题，但是你可以为自己解决的问题越多，你就越能发展自己的VBA知识。

lngLstRow = ActiveSheet.UsedRange.Rows.Count

除非您确切知道自己在做什么，否则最好避免使用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是查找工作表的最后一行和/或列的最佳方式。 What:="*"意味着寻找任何东西。请注意，SearchOrder的值不同。工作表不是矩形并不重要;最后一行和最后一列不必是同一个单元格。

但是，没有找到适用于所有情况的最后一行或列的方法。按列搜索时Find没有“看到”合并的单元格。（警告，我使用的是旧版本的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说这是数组Fruit的索引。我可以看一下几年前写的宏，并立即知道所有变量是什么。

如果您使用LBound(Fruit)，

Array将始终为零。另请注意，Fruit必须是Variant类型。优点是，当您想要添加水果D和E时，您只需更改为：

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

如果找到该名称，它将继续检查“提交的”列，并检查提交的日期是否在每周日期之间。（如果日期在2月23日/ 2015-2 / 27/2015之间）。

你找到有趣水果行的技术并不是最好的技术，但我认为它已经足够了。我在没有讨论其他方法的情况下给你足够的思考。

我猜您想知道日期是否在当周的星期一和星期五之间。

Now()为您提供当前的日期和时间。下一个宏显示如何计算一周中任何一天的星期一和星期五。如果你选择复制这种技术，请妥善记录，以便在一年的时间内更新你的宏的可怜的草皮。这个宏是功能和常量的聪明算术。我不喜欢聪明的代码，除非它被正确记录，因为它通常是程序员炫耀而不是使用最简单的方法解决问题。

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将日期保存为数字，以便您可以编写If Monday <= TransDate And TransDate <= Friday Then。

将数据从一个工作表移动到另一个工作表的技术很笨拙。该宏将工作表“Sheet2”中的“A”，“a”，“B”，“b”，“C”或“c”的每一行从工作表“Sheet2”移动到“Sheet3”。我相信你会同意最内层的循环比你的更清楚。

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

需要一个excel宏来根据多个标准进行搜索和复制

1 个答案: