过滤后的视图VBA Excel

时间:2014-12-29 10:28:33

标签: excel vba excel-vba

我有一个自动提交的文件,其中包含第(4)行标题

第一列(A)包含不同的类别(付款类型),在特定类型的基础上,我将根据我正在处理的文件中包含的某个工作表运行不同的测试。

我现在在做什么基本上是根据我要检查的付款类型创建一个过滤器(第一列A),创建一个临时表,复制粘贴这个过滤后的视图,用支票进行处理然后将结果(包含在R列中)复制/粘贴到主工作表中。

问题出现在最后一部分,当我想要复制粘贴时,因为过滤后的视图我不能只是去R的标题下的第一个空闲单元格并复制粘贴,因为系统没有明白我正在进入过滤后的视图。我必须确保我在A列中包含的值(字符串)的基础上复制粘贴正确的结果,你能帮我解决吗?

另一种方法是为每个循环执行一次,但实际上我不确定如何构造它。

这里我们有一部分我正在处理的代码

Sub Payexample()
' normal cleaning procedures
    Sheets("Payexample").Select
    Rows("1:10").Select
    Selection.Delete Shift:=xlUp

    Columns("J:J").Select
    Selection.Replace What:="AED", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.NumberFormat = "0.00"


    Sheets("Sheet1").Select

    ActiveSheet.Range("$A$4:$A$500").AutoFilter Field:=1, Criteria1:="Payfort"
    Range("A5 : N5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Payfort momentary"
    Range("A1").Select
    ActiveSheet.Paste

    Range("$M$1").Formula = Range("B1") & (",") & Range("M1")

    Dim Lastrow As Long

    Application.ScreenUpdating = False

    Lastrow = Range("J" & Rows.Count).End(xlUp).Row
    Range("O1").FormulaR1C1 = "=IF(RC[-2]-VLOOKUP(RC[-3],'PayFort'!B:J,9,FALSE)<=0.99, ""Payfort          Payment Checked"", ""Manual Verification Needed"")"
    Range("O1").AutoFill Destination:=Range("O1:O" & Lastrow)
        Range("O1:O" & Lastrow).Select
        Selection.Copy
        Sheets("Sheet1").Select

    ActiveSheet.Range("$A$4:$A$500").AutoFilter Field:=1, Criteria1:="Payfort"

    Range("R5").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

        'Sheets("Payfort Momentary").Select
        'ActiveWindow.SelectedSheets.Delete

End Sub

1 个答案:

答案 0 :(得分:0)

我认为这将主要是你所追求的,但我不确定你想用你的公式做什么,希望你能从这里找出你想做的事情:

Sub Payexample()
Dim rngCheck As Range
Dim r As Range
Dim rowNum As Long
' normal cleaning procedures
    Sheets("Payexample").Select
    Rows("1:10").Select
    Selection.Delete Shift:=xlUp

    Columns("J:J").Select
    Selection.Replace What:="AED", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.NumberFormat = "0.00"

    Sheets("Sheet1").Select
    With ActiveSheet
        rngCheck = .Range("$A$4:$A$500")
        For Each r In rngCheck.Rows ' Loop through the rows in your data area
            rowNum = r.Row
            If .Range("A" & rowNum) = "Payfort" Then
                ' Either
                .Range("R" & rowNum).Formula = "" ' Your formula here
                .Range("R" & rowNum) = .Range("R" & rowNum).Value ' Change formula to value
                ' Or
                .Range("R" & rowNum) = ' Do calculations in VBA without formula
            End If
        Next r
    End With

End Sub