VBA基于date和其他标识符返回值循环

我正在做一些工作，需要自动支付审批请求，我遇到的问题是有多个支付请求多个支付的标识符，所以例如，我希望使用国旗苹果和5支付与支付4付款香蕉。 macros将需要查看所有与今天付款date的付款，然后确定这笔付款是否为苹果或香蕉。 然后，它将复制今天的所有付款，并将它们粘贴到另一张纸上。

假设date标识符位于Source Data Sheet上的单元格A2中，date位于单元格F4到F2000中，而Apple / Banana标志位于G4到G2000中。

我想在单元格H4到H2000中获取付款的价值，并将它们粘贴在Apples Payment选项卡或Banana Payment选项卡上，以及它们在单元格I4到I2000中的唯一引用号。

我试图用我在这里find的其他东西，但我真的很挣扎，有人可以帮我！

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中，并将其放入Apple工作表或基于该标志的Banana工作表中：

 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