代码之家 › 专栏 › 技术社区 › Smokestack

过滤器范围C3:G3并粘贴到其他单元格

vba excel

Smokestack · 技术社区 · 4 月前

我的值在C3:G3的范围内。我设置了一个过滤器,如果你看手表区域,它就可以工作。当它粘贴输出时,它只粘贴过滤范围内的第一个项目。这是代码。我想也许我必须转置它。所以增加了转置。两者都给出了相同的单一输出。

Sub filter_test()
Dim PhoneAry As Variant
Dim myAry(0 To 4) As String


myAry(0) = Range("C3").Value
myAry(1) = Range("D3").Value
myAry(2) = Range("E3").Value
myAry(3) = Range("F3").Value
myAry(4) = Range("G3").Value

PhoneAry = filter(myAry, "Wireless")
    
Dim Destination As Range
Set Destination = Range("C4:G4")
Set Destination = Destination.Resize(UBound(PhoneAry), 1)

Destination.Value = Application.transpose(PhoneAry)
End sub

这是它的样子。

2 回复 | 直到 4 月前

MGonet 4 月前

PhoneAry 从索引 0 .In Resize 您应该添加 1 .

Sub filter_test()
Dim PhoneAry As Variant
Dim myAry(0 To 4) As String


myAry(0) = Range("C3").Value
myAry(1) = Range("D3").Value
myAry(2) = Range("E3").Value
myAry(3) = Range("F3").Value
myAry(4) = Range("G3").Value

PhoneAry = Filter(myAry, "Wireless")
    
Dim Destination As Range
Set Destination = Range("C4:G4")
Set Destination = Destination.Resize(1, UBound(PhoneAry) + 1)

Destination.Value = PhoneAry
End Sub

VBasic2008 4 月前

过滤行

代码的直接问题在 MGonet的 回答。
如果你想弄脏你的手,请研究以下内容,即如果你的范围有数百个单元格,你不想仅仅为了填充数组而写数百行重复的行。

Sub FilterRow()
    
    ' Define constants.
    Const SRC_ROW_ADDRESS As String = "C3:G3"
    Const DST_FIRST_CELL_ADDRESS As String = "C4"
    Const LIKE_PATTERN As String = "*Wireless*"
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the single-row source range and retrieve its number of columns.
    Dim srg As Range: Set srg = ws.Range(SRC_ROW_ADDRESS)
    Dim sColumnsCount As Long: sColumnsCount = srg.Columns.Count
    
    ' Return the values of the source range in a 2D one-based single-row array.
    Dim Data() As Variant: Data = srg.Value ' assumes multiple cells!
    
    ' Declare additional variables.
    Dim sCol As Long, dColumnsCount As Long, IsMisMatch As Boolean
    
    ' Loop through the row of the array and 'stack' the matches
    ' at the left of the array. The 'IsMisMatch' Boolean ensures
    ' writing only after the first mismatch i.e. no need to write
    ' if e.g. the first 10 consecutive values are matching.
    For sCol = 1 To sColumnsCount
        If CStr(Data(1, sCol)) Like LIKE_PATTERN Then
            dColumnsCount = dColumnsCount + 1
            If IsMisMatch Then Data(1, dColumnsCount) = Data(1, sCol)
        Else
            IsMisMatch = True
        End If
    Next sCol
    
    ' Reference the destination range, a range of the same size
    ' as the source range, and clear its contents.
    Dim dcell As Range: Set dcell = ws.Range(DST_FIRST_CELL_ADDRESS)
    Dim drg As Range: Set drg = dcell.Resize(, sColumnsCount)
    drg.ClearContents
    
    ' Return the matches (if any) in the possibly down-sized destination range.
    If dColumnsCount > 0 Then drg.Resize(, dColumnsCount).Value = Data
    
End Sub