如何仅选择填写的值并在 Excel 的另一个工作表中使用它们？

Question

我的excel中有一大堆需要填写的数据参数，其中第一列是参数名称，第二列是要填写的值，第三列是对应的单位。 我想创建第二个工作表，其中仅显示实际填写的值及其相应的名称和单位。我不希望它们之间有任何间隙。

我对在 excel 和 VBA 中使用条件非常陌生，所以希望这里有人可以帮助我。我已经根据在网上找到的类似情况尝试了几件事，但似乎无法找到正确的方法，而且我总是最终要么在值之间存在差距，要么得到无法工作的代码。

谢谢！

Answer 1

如果您使用的是较新版本的 Office（例如 Office 365），只需使用

Filter

-功能即可。

假设参数表名为“Sheet1”，将以下公式放入第二个表中：

=FILTER(Sheet1!A:C,Sheet1!B:B<>"","no data found")

Sheet1!A:C

告诉您要从哪里获取数据

Sheet1!B:B<>""

定义了一个过滤器：仅当B列中的值不为空时才显示数据。

"no data found"

如果没有找到匹配的数据（尚未填充参数）则写入文本

由于这是一个公式，只要参数表中的内容发生更改，它就会自动更新第二张表中的列表。

Answer 2

复制过滤值

主要

Sub CopyFilteredValues()
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source worksheet.
    Dim sws As Worksheet: Set sws = wb.Sheets("Sheet1")
    
    ' Reference the source range.
    
    Dim srg As Range, srCount As Long
    
    With sws.Range("A2")
        srCount = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row - .Row + 1
        If srCount < 1 Then
            MsgBox "No data found in range """ _
                & .Resize(sws.Rows.Count - .Row + 1).Address(0, 0) _
                & """ of sheet """ & sws.Name & """!", vbExclamation
            Exit Sub
        End If
        Set srg = .Resize(srCount, 3)
    End With
            
    ' Return the values of the source range in an array.
    
    Dim Data() As Variant: Data = srg.Value
    
    ' Write the rows that meet the conditions to the top of the array.
    
    Dim sr As Long, dr As Long, c As Long
    
    For sr = 1 To srCount
        If AreConditionsMet(Data(sr, 1), Data(sr, 2)) Then
            dr = dr + 1
            For c = 1 To 3
                Data(dr, c) = Data(sr, c)
            Next c
        End If
    Next sr
    
    ' Write the values from the top of the array to the destination sheet.
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Sheet2")
    
    With dws.Range("A2").Resize(, 3)
        ' Write.
        If dr > 0 Then .Resize(dr).Value = Data
        ' Clear below.
        .Resize(dws.Rows.Count - dr - .Row + 1).Offset(dr).Clear
    End With
    
    ' Inform.
    
    If dr = 0 Then
        MsgBox "No row in the range """ & srg.Address(0, 0) _
            & """ of sheet """ & sws.Name & """ meets the conditions!", _
            vbExclamation
    Else
        MsgBox "Filtered values copied.", vbInformation
    End If

End Sub

帮助

Function AreConditionsMet(Value1 As Variant, Value2 As Variant) As Boolean
    If IsBlank(Value1) Then Exit Function
    If IsNumberCellValue(Value2) Then AreConditionsMet = True ' is a number
    ' Or:
    'If Not IsBlank(Value2) Then AreConditionsMet = True ' is not blank
End Function

Function IsBlank(Value As Variant) As Boolean
    If Len(CStr(Value)) = 0 Then IsBlank = True
End Function

Function IsNumberCellValue(Value As Variant) As Boolean
    If VarType(Value) = vbDouble Then IsNumberCellValue = True
End Function