VBA返回基于日期和一个其他标识符的值循环

Question

我正在做一些需要自动化付款审批请求的工作，我遇到的问题是，有两个标识符用于多次付款的付款请求，因此，例如，我希望用标志苹果进行4次付款，用标志香蕉进行5次付款。宏需要查找所有付款日期为今天的付款，然后确定这笔付款是针对苹果还是香蕉。然后，它将复制今天的所有付款，并将其粘贴在另一张纸上。

假设日期标识符在源数据表的单元格A2中，日期在单元格F4到F2000中，苹果/香蕉标志在G4到G2000中。

我想在单元格H4到H2000中获取付款的值，并将其粘贴在"苹果付款"选项卡或"香蕉付款"选项卡上，同时在单元格I4到I2000中粘贴其唯一参考号。

我试图使用我在这里找到的其他东西，但我真的很挣扎，有人能帮帮我吗！

Sub Fruit()
Dim lastRow As Long
Dim lastTRow As Long    'Last Target Row
Dim tRow As Long        'Target Row
Dim source As String    'The source sheet
Dim target As String    'Variable target sheet
Dim tempVal As String   'Hold value of Source!B2
Dim ws As Worksheet
source = "Source Data"
lastRow = Sheets("Source Data").Range("D" & Rows.Count).End(xlUp).Row
For lRow = 3 To lastRow                 'Loop through source sheet
tempVal = Sheets("Source Data").Cells(lRow, "D").Text
If Sheets("Source Data").Cells(lRow, "F").Value = tempVal Then
Sheets("Source Data").Cells(lRow, "I").Copy
lastTRow = Sheets("Banana").Range("C" & "70").End(xlUp).Row          'Get Last Row
tRow = lastTRow + 1             'Set new Row 1 after last
'tRow.Select.Paste
'Copy cells from one sheet to another loop columns
Sheets("Banana").Cells(tRow, "C").PasteSpecial
End If
Next lRow
End Sub

Answer 1

您的代码与您描述的不完全匹配，所以我沿用了您的描述。你的代码有几个问题：

• 没有复制H列中的值
• 缺少第二个if语句会将值分配给香蕉或苹果电子表格

我已经更新了您的代码，以便在H列中检查标志，然后将H和I中的值移动到单元格C&根据标志：将D插入苹果工作表或香蕉工作表

Sub Fruit()
Dim lastRow As Long
Dim lastRowData As Long, lastRowApples As Long, lastRowBananas As Long  'Last Target Row
Dim tRow As Long        'Target Row
Dim tempVal As String   'Hold value of Source!B2
Dim wsSource As Worksheet, wsApples As Worksheet, wsBananas As Worksheet
Set wsSource = ThisWorkbook.Sheets("Source Data")
Set wsApples = ThisWorkbook.Sheets("Apples")
Set wsBananas = ThisWorkbook.Sheets("Bananas")
lastRowData = wsSource.Range("D" & Rows.Count).End(xlUp).Row
For lRow = 3 To lastRowData 'Loop through source sheet
If wsSource.Range("D" & lRow).Value = wsSource.Range("F" & lRow).Value Then
If wsSource.Range("G" & lRow).Value = "Apples" Then ' check for apple flag in column G
wsSource.Range("H" & lRow & ":I" & lRow).Copy wsApples.Range("C" & wsApples.Range("C" & Rows.Count).End(xlUp).Row + 1) 'Copy Cells H&I in Cells C:D in the sheet
ElseIf wsSource.Range("G" & lRow).Value = "Bananas" Then ' check for banana flag in column G
wsSource.Range("H" & lRow & ":I" & lRow).Copy wsBananas.Range("C" & wsBananas.Range("C" & Rows.Count).End(xlUp).Row + 1) 'Copy Cells H&I in Cells C:D in the sheet
End If
End If
Next lRow
End Sub

Answer 2

你可以试试这个

Option Explicit
Sub Fruit()
With Sheets("Source Data")
With .Range("I3", .Cells(.Rows.count, "F").End(xlUp))
.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, .Parent.Range("A2").Value)
FilterAndCopy .Cells, "banana", "Banana Payment"
FilterAndCopy .Cells, "apple", "Apples Payment"
End With
.AutoFilterMode = False
End With
End Sub
Sub FilterAndCopy(rng As Range, filterValue As String, destShtName As String)
With rng
.AutoFilter Field:=2, Criteria1:=filterValue
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.count - 1, 2).Offset(, 2).SpecialCells(xlCellTypeVisible).Copy Worksheets(destShtName).Range("A1")
End With
End Sub