excel 指定月份内返回分录

esyap4oy 于 2023-03-31 发布在其他

关注(0)|答案(1)|浏览(81)

我有很多行的电子表格。在列“S”是3位数的代码和列“T”日期在dd/mm/yyyy格式。我想创建一个宏将搜索所有行指定的代码（写在单元格“S1”中）（月/年写在单元格“T1”中），并将这两个条件为真的整行复制到新工作表中。因此，在下面的示例中，第5行应复制到新工作表中。
| 行|色谱柱S|色谱柱T|
| --------------|--------------|--------------|
| 1|306|2019 - 02 - 22 2019 - 02 - 22|
| 第二章|二百二十三|2022年1月1日|
| 三|三零六|2022年3月1日|
| 四|四百五十六|2022年2月2日|
| 五|三零六|2022年2月3日|
| 五|二三一|2022年2月2日|
在一些帮助下，我设法编写了VBA代码-如果涉及到搜索具有单元格S1中的代码的行，则它正在做正确的事情，但是如果涉及到日期，则它将返回单元格T1中指定的从年初到月底的所有条目，而不仅仅是本月的条目。

Function IsDateInMonth _
  (d As Date, m As Date) As Boolean

Dim dStart As Date
Dim dEnd As Date

dStart = CDate(VBA.Month(m) & "/01/" & VBA.Year(m))
dEnd = WorksheetFunction.EoMonth(m, 0)

If d >= dStart And d <= dEnd Then IsDateInMonth = True

End Function

Sub Macro()

Dim strCode As String
Dim datDate As Date
Dim rngCell As Range
Dim lngLoop As Long
Dim wksSource As Worksheet
Dim wksTarget As Worksheet

Set wksSource = ActiveWorkbook.Worksheets("TABLE")
Set wksTarget = ActiveWorkbook.Worksheets("Sheet2")

lngLoop = 2

strCode = Range("S1")
datDate = Range("T1")

For Each rngCell In wksSource.Range("S4:S30000")

  If rngCell = strCode _
  And IsDateInMonth(rngCell.Offset(, 1), datDate) Then

    wksSource.Rows(rngCell.Row).Copy wksTarget.Rows(lngLoop)
    lngLoop = lngLoop + 1

  End If

Next rngCell

End Sub

我只需要单元格$S$1中指定了代码的行，以及单元格$T$1中指定月份的行

excel

来源：https://stackoverflow.com/questions/75833350/returning-entries-within-specified-month

1条答案

按热度按时间

jhdbpxl91#

尝试

Sub FindAndCopy()
    Dim searchValue, firstAddress
    Dim oRng As Range, fRng As Range
    Dim lngLoop As Long: lngLoop = 2
    Dim wksTarget As Worksheet
    Dim wksSource As Worksheet
    
    Set wksSource = ActiveWorkbook.Worksheets("TABLE")
    Set oRng = wksSource.Range("S4:S30000")
    searchValue = wksSource.Range("S1")
    Set wksTarget = ActiveWorkbook.Worksheets("Sheet2")
    
    Set fRng = oRng.Find(What:=searchValue, _
                              After:=oRng.Cells(oRng.Cells.Count), _
                              LookIn:=xlValues, _
                              LookAt:=xlWhole, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlNext, _
                              MatchCase:=False)
        If Not fRng Is Nothing Then
            firstAddress = fRng.Address
            Do
                 If fRng = searchValue _
                 And Month(fRng.Offset(0, 1)) = Month(wksSource.Range("T1")) _
                 And Year(fRng.Offset(0, 1)) = Year(wksSource.Range("T1")) Then
                    wksSource.Rows(fRng.Row).Copy wksTarget.Rows(lngLoop)
                    lngLoop = lngLoop + 1
                  End If
                  Set fRng = oRng.FindNext(fRng)
             Loop While Not fRng Is Nothing And fRng.Address <> firstAddress
        End If
        Msgbox "Copy complete"
End Sub

赞(0）回复(0）举报 2023-03-31

我来回答

excel 指定月份内返回分录

1条答案

相关问题

热门标签

最新问答