Question

我想知道是否有办法浏览过滤器列表。对于每个筛选列表，我将执行一个公式。即

Company Name             Invoice Number              Voucher Number
CompanyA                 000001                      TX100
CompanyA                 000001                      //copy what's on top
CompanyA                 000001                     //copy what's on top
CompanyB                 000002
CompanyB                 000002
CompanyC                 000003                     TY909
CompanyC                 000003                     //copy what's on top

基本上我需要过滤列公司名称（范围A过滤器），因为您可以注意到每个公司名称缺少一些凭证行值的行，我只需要用相同的凭证号填充它，这样就可以了。就像......

Company Name             Invoice Number              Voucher Number
    CompanyA                 000001                      TX100
    CompanyA                 000001                      TX100
    CompanyA                 000001                      TX100
    CompanyB                 000002
    CompanyB                 000002
    CompanyC                 000003                     TY909
    CompanyC                 000003                     TY909

我希望输出像那样通知我不需要填写那些没有凭证号码的人，即CompanyB

我已经尝试过此代码，但没有过滤每家公司...

Range("V2:V" & xRow).SpecialCells(xlCellTypeVisible).Formula = "=IF(J2<>"""",J2,IF(V1="""","""",V1))"
Range("V2:V" & xRow).SpecialCells(xlCellTypeVisible).Value = Range("V2:V" & xRow).SpecialCells(xlCellTypeVisible).Value
Range("V1:V" & xRow).SpecialCells(xlCellTypeVisible).Copy
Range("J1").PasteSpecial Paste:=xlPasteValues

困境是它将所有内容复制在一起，如果是这样的话，那就像

Company Name             Invoice Number              Voucher Number
    CompanyA                 000001                      TX100
    CompanyA                 000001                      TX100
    CompanyA                 000001                      TX100
    CompanyB                 000002                      TX100
    CompanyB                 000002                      TX100
    CompanyC                 000003                     TY909
    CompanyC                 000003                     TY909

这是错误的。任何帮助？或改进。

更新我尝试过使用过滤器

Sub try()
Dim currRng As Range, dataRng As Range, currCell As Range
Dim xRow As Long
xRow = Cells(rows.Count, "A").End(xlUp).row
With ActiveSheet
        Set currRng = .Range("A1", .Cells(.rows.Count, "A").End(xlUp))
        Set dataRng = .Range("V2:V" & xRow)
       ' Range("AF:XFD").Delete
        With .UsedRange
            With .Resize(1, 1).Offset(, .Columns.Count)
                With .Resize(currRng.rows.Count)
                    .Value = currRng.Value
                    .RemoveDuplicates Array(1), Header:=xlYes
                    For Each currCell In .SpecialCells(xlCellTypeConstants)
                        currRng.AutoFilter field:=1, Criteria1:=currCell.Value
                        If Application.WorksheetFunction.Subtotal(103, currRng) - 1 > 0 Then
                            dataRng.Value = Range("I2").Value
                            dataRng.SpecialCells(xlCellTypeVisible).Formula = "=IF(I2<>"""",I2,IF(V2="""","""",V2))"
                            dataRng.Value = dataRng.Value
                            dataRng.Copy Destination:=Range("I2")
                            dataRng.ClearContents
                        End If
                       Next currCell
                    .ClearContents
                End With
            End With
        End With
        .AutoFilterMode = False
    End With
End Sub

范围（＆＃34; V：V＆＃34;）是我存储/转储我的公式的地方，范围（＆＃34; I：I＆＃34;）是凭证编号为的列范围存储，但我仍然没有结果或null。我需要过滤每个公司和该公司，如果该公司的第一行结果为null使其全部为空（例如在我的样本中的CompanyB中），如果它有一个值（如我的样本公司A和CompanyC）填写那些下来。

Answer 1

在OP关于数据放置的澄清之后编辑

。

你可以使用这个

Range("V2:V" & xRow).SpecialCells(xlCellTypeVisible).Formula =IF(I2<>"""",I2,IF(A2<>A1,"""",IF(U1="""","""",U1)))

Answer 2

经过多次尝试，我已经想出了这段代码......

Sub voucher_num()
Dim cell As Range, currRng As Range, dataRng As Range, currCell As Range, destRng As Range
Dim xRow As Long
xRow = Cells(rows.Count, "A").End(xlUp).row
With ActiveSheet
        Set currRng = .Range("A1", .Cells(.rows.Count, "").End(xlUp)) 'column range of my filter
        Set dataRng = .Range("V2:V" & xRow) 'range of column I'm dumping my formula
        Set destRng = .Range("I2:I" & xRow) 'storing again the values I've come up with from the formula

        With .UsedRange
            With .Resize(1, 1).Offset(, .Columns.Count)
                With .Resize(currRng.rows.Count)
                    .Value = currRng.Value
                    '.RemoveDuplicates Array(1), Header:=xlYes
                For Each currCell In .SpecialCells(xlCellTypeConstants)

                currRng.AutoFilter Field:=1, Criteria1:=currCell.Value

                If Application.WorksheetFunction.Subtotal(103, currRng) - 1 > 0 Then
                    dataRng.SpecialCells(xlCellTypeVisible).Value = destRng.SpecialCells(xlCellTypeVisible).Value
                    dataRng.SpecialCells(xlCellTypeVisible).FillDown
                    dataRng.SpecialCells(xlCellTypeVisible).Value = dataRng.SpecialCells(xlCellTypeVisible).Value
                    dataRng.SpecialCells(xlCellTypeVisible).Copy Destination:=destRng.SpecialCells(xlCellTypeVisible)
                    dataRng.SpecialCells(xlCellTypeVisible).ClearContents
                End If

        Next currCell
    .ClearContents
            End With
        End With
    End With
    .AutoFilterMode = False
End With
End Sub

这需要你花费很多时间，我还没有想出更好/更快的方法，但这正是我想要的。

Answer 3

以下代码有助于仅在可见单元格中复制和粘贴公式。它对我来说很好。你也可以放任何其他公式。

    Dim Xrow As Long, WS As Worksheet, dng As Range
    Xrow = Cells(Rows.Count, "A").End(xlUp).Row

    With ActiveSheet
    Set WS = ActiveSheet
    Set dng = .Range("H1:H" & Xrow)
    WS.Range("A1:BD1" & Xrow).AutoFilter Field:=12, Criteria1:="Sheets"
    Range("H1").Select
    dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RC[1]"
    End With

'删除自动过滤器 ActiveSheet.ShowAllData

'要复制和粘贴列的特殊值，请使用以下内容 Columns.EntireColumn（ “H”）。复制

    Columns.EntireColumn("H").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    End Sub

使用公式VBA过滤和填充可见单元格

3 个答案: