☰

我试图让 Excel 从一张表中提取数据，并在满足某些条件的情况下将其列在另一张表上

tag-icon • tag-icon microsoft-excel worksheet-function
我试图让 Excel 从一张表中提取数据，并在满足某些条件的情况下将其列在另一张表上

本质上，这就是我想要的，但我不知道该怎么做。我想要一个公式或一个可以执行以下操作的函数。

如果 A1<>“Vacant” AND B1="x" THEN 将文本从 A1 添加到 List1

这样做的目的是生成一个可以复制到单独工作表的姓名列表。这就是我要做的。我创建了一个标记了休息日的人员配置模式。我想要一个函数来编译一份在给定日期休息的人员的姓名列表，用 B 到 H 列表示。我还需要它忽略任何列为“空缺”的姓名，因为这些位置需要保留，但目前还没有填补。编译好该列表后，我需要让 excel 使用该列表填写轮班名册上经常休息的人员的列。

在评论中讨论并对我所做的事情的理解有了很大进展之后，我仍然陷入僵局。

我不知道我做错了什么。我尝试更改我收到的代码中的引用，但它没有给我任何输出，而且我对 VBA 不够熟悉，不知道我做错了什么。这是我使用的代码：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim nameRange As Range, entry As Range

Set nameRange = Worksheets("Staffing Pattern").Range(Range("A7"), Range("A21").End(xlUp))

If Not Application.Intersect(Range(Target.Address), Range("A:H")) Is Nothing Then
    Worksheets("Sunday").Range("F81:F" & Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row).Value = ""
    For Each entry In nameRange
        If UCase(entry.Value) <> "VACANT" And UCase(entry.Offset(0, 1).Value) = "X" Then
        Worksheets("Sunday").Range("F" & Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row).Value = entry.Value
        End If
    Next entry
End If
End Sub

编辑 我最终结合使用了两种答案，并运用了谷歌的一点小聪明。我使用 Power Queries 做了我想要做的事情，然后使用 VBA 编写宏并将它们链接到页面上的按钮。宏一次只刷新两个 Power Queries，因此系统不会崩溃，并且每个班次名册上都有一个按钮。感谢大家帮助解决这个问题！

我用于宏的代码：

Sub Macro1()
'
' Macro1 Macro
' Refresh Sunday
'
' Keyboard Shortcut: Ctrl+s
'
Dim con As WorkbookConnection
Dim Cname As String

For Each con In ActiveWorkbook.Connections
    If Left(con.Name, 11) = "Query - Sun" Then
    Cname = con.Name
        With ActiveWorkbook.Connections(Cname).OLEDBConnection
            .BackgroundQuery = False  'or true, up to you
            .Refresh
        End With
    End If
Next
End Sub

然后，每个宏都会被修改以应用于一周中的每一天，并且会有一个按钮与其链接。它运行完美！

答案1

我将使用“Power Query”：选择您的输入范围，转到数据丝带并选择来自表/范围。然后使用每个列标题上的过滤按钮应用您的条件：

  • 列1...文本过滤器...不等于...空白
  • 列 2...文本过滤器...等于...x

然后右键单击 Column2 并选择删除列。然后点击关闭并加载按钮在新的工作表上生成包含结果的新表。您可以在过程中调整“关闭和加载”选项。

将来只需点击刷新按钮数据功能区刷新输出表。

答案2

您实际上无法使用函数将某些内容添加到列表中，因为函数仅指示在特定单元格中显示的内容。您可以做的是使用函数填充列表，以便它可以自行填充。或者使用宏。使用一些视觉表示更容易准确地制作您想要的内容，但您可以编写您描述的函数：

=IF(A1<>"Vacant",IF(B1="x",A1,""),"")

VBA 内容：

首先，当您想让宏自动运行的时候，您可以把它们放在工作表中。只需右键单击工作表即可，或者只需在 VBA 编辑器中选择工作表即可。

Worksheet_Change是一个很有用的函数，每次发生更改时都会运行宏。通常伴随着范围限制，如下所示：

If Not Application.Intersect(Range(Target.Address), Range("A2:D5")) Is Nothing Then

仅当我们想要检查的范围内发生变化时才运行它。

你可以做类似的事情： 

Private Sub Worksheet_Change(ByVal Target As Range)

Dim nameRange As Range, entry As Range

Set nameRange = ActiveSheet.Range(Range("A2"), Range("A65000").End(xlUp))

If Not Application.Intersect(Range(Target.Address), Range("A:B")) Is Nothing Then
    Range("E2:E" & Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row).Value = ""
    For Each entry In nameRange
        If UCase(entry.Value) <> "VACANT" And UCase(entry.Offset(0, 1).Value) = "X" Then
        Range("E" & Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row).Value = entry.Value
        End If
    Next entry
End If
End Sub

E使用列中的值填充列A。

![在此处输入图片描述

这种方法的缺点是每次更新时我们都会删除并写入列表。所以如果我们有一个很长的列表，它可能会变得很慢。

您可以使用相同的方法来更新 Power Query，但使用以下行：

ThisWorkbook.Worksheets("Sheet2").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False

显然Sheet2这是一张带有 PQ 的表格。

编辑

所以，我做了一些编辑调整。可能还可以做更多，但这取决于你想如何使用它。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nameRange As Range, entry As Range, outCol As String, oCN As Long, outSheet As Worksheet

Set nameRange = Worksheets("Staffing Pattern").Range("A7:A21")
Set outSheet = Worksheets("Sunday")
outCol = "F"


oCN = Columns(outCol).Column
If Not Application.Intersect(Range(Target.Address), Range("A:H")) Is Nothing Then
    outSheet.Range(outCol & "2:" & outCol & outSheet.Cells(Rows.Count, oCN).End(xlUp).Offset(1, 0).Row).Value = ""
    For Each entry In nameRange
        If UCase(entry.Value) <> "VACANT" And UCase(entry.Offset(0, 1).Value) = "X" Then
        outSheet.Range(outCol & outSheet.Cells(Rows.Count, oCN).End(xlUp).Offset(1, 0).Row).Value = entry.Value
        End If
    Next entry
End If
End Sub

目前，这将清除输出表中的整个输出列。然后从输出列第 2 行开始向下填充，并使用 nameRange 中不“空白”且具有相邻 X 的值。

如果要将其应用于多个位置，可以将要更改的每个选项转换为变量，然后调用它。主要是为了不一遍又一遍地重复所有代码。

我的意思是这样的： 在正在编辑列表的表单中，输入如下内容：

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Range(Target.Address), Range("A:H")) Is Nothing Then
    Call writeList("Staffing Pattern", "A7:A21", "Sunday", "F")
    Call writeList("Staffing Pattern", "C5:C40", "Sunday", "H")
    Call writeList("Staffing Pattern", "A7:A21", "Saturday", "F")
End If
End Sub

然后在模块中放入如下内容：

Public Sub writeList(ByVal inSheet As String, nameRange As String, outSheet As String, outCol As String)
Dim entry As Range, oCN As Long, outS As Worksheet, nRange As Range

Set nRange = Worksheets(inSheet).Range(nameRange)
Set outS = Worksheets(outSheet)
oCN = Columns(outCol).Column

    outS.Range(outCol & "2:" & outCol & outS.Cells(Rows.Count, oCN).End(xlUp).Offset(1, 0).Row).Value = ""
    For Each entry In nRange
        If UCase(entry.Value) <> "VACANT" And UCase(entry.Offset(0, 1).Value) = "X" Then
        outS.Range(outCol & outS.Cells(Rows.Count, oCN).End(xlUp).Offset(1, 0).Row).Value = entry.Value
        End If
    Next entry

End Sub

如果您愿意，您可以直接在 Sheet 代码中将它们放在彼此之下，无需将其放在模块中。您可以将其放在任何地方，因为它是公开的。

您还可以拆分表单代码，这样就不必重新绘制不受更改影响的列表。使用多个 IF 或使用 else if

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Range(Target.Address), Range("A:B")) Is Nothing Then
    Call writeList("Staffing Pattern", "A7:A21", "Sunday", "F")
    Call writeList("Staffing Pattern", "A7:A21", "Saturday", "F")

ElseIf Not Application.Intersect(Range(Target.Address), Range("C:D")) Is Nothing Then
    Call writeList("Staffing Pattern", "C5:C40", "Sunday", "H")

End If
End Sub

相关内容