Excel宏：如果B列有；“X”；，然后复制整行并粘贴到名为“QUOTE”的工作表中；B栏“；_Excel_Vba

Excel宏：如果B列有；“X”；，然后复制整行并粘贴到名为“QUOTE”的工作表中；B栏“；

excel vba

Excel宏：如果B列有；“X”；，然后复制整行并粘贴到名为“QUOTE”的工作表中；B栏“；,excel,vba,Excel,Vba,我写宏的经验有限，我正在寻找更新工作中使用的当前电子表格。目前，我们复制整个主工作表并将其粘贴到其他工作表中，然后对某些列中的“X”进行排序，以删除主工作表上的其他行我要做的是搜索主工作表，如果B列有一个“X”，则复制整行并将其粘贴到名为“B列”的工作表中。然后，一旦B列完成并粘贴，它将查看D列。如果D列有一个“X”，它将复制整行并将其粘贴到名为“D列”的工作表选项卡中提前谢谢方法我应该在我的答案的第一个版本中包含这一点我的解决方案依赖于自动筛选。我首先提供了一个play解决方案，通过

我写宏的经验有限，我正在寻找更新工作中使用的当前电子表格。目前，我们复制整个主工作表并将其粘贴到其他工作表中，然后对某些列中的“X”进行排序，以删除主工作表上的其他行

我要做的是搜索主工作表，如果B列有一个“X”，则复制整行并将其粘贴到名为“B列”的工作表中。然后，一旦B列完成并粘贴，它将查看D列。如果D列有一个“X”，它将复制整行并将其粘贴到名为“D列”的工作表选项卡中

提前谢谢

方法

我应该在我的答案的第一个版本中包含这一点

我的解决方案依赖于自动筛选。我首先提供了一个play解决方案，通过以下方式演示了这种方法：

使B列中不包含X的行不可见

使D列中不包含X的行不可见

清除自动过滤器

如果这种方法有吸引力，请参考我对另一个问题的回答，该问题创建了一个菜单，用户可以选择他们想要的过滤器

如果这种方法没有吸引力，我提供了第二种解决方案，它涉及将每个过滤器留下的可见行复制到其他工作表

导言

你说“我写宏的经验有限”，我认为这意味着你有一些经验。我希望我的解释水平是正确的。如果有必要，带着问题回来

' Option Explicit means I have to declare every variable.  It stops
' spelling mistakes being taken as declarations of new variables.
Option Explicit

' Specify a subroutine with two parameters
Sub CreateSubSheetB(ByVal WShtSrcName As String, ByVal ColSrc As Long)

  ' This macro applies an AutoFilter based on column ColSrc
  ' to the worksheet named WShtSrcName

  Dim RngVis As Range

  With Sheets(WShtSrcName)
    If .AutoFilterMode Then
      ' AutoFilter is on.  Cancel current selection before applying
      ' new one because criteria are additive.
      .AutoFilterMode = False
    End If

    ' Make all rows which do not have an X in column ColSrc invisible
    .Cells.AutoFilter Field:=ColSrc, Criteria1:="X"

    ' Set the range RngVis to the union of all visible rows
    Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

  End With

  ' Output a string to the Immediate window.
  Debug.Print "Rows with X in column " & ColSrc & ": " & RngVis.Address

End Sub

' A macro to call CreateSubSheetB for different columns
Sub CtrlCreateSubSheetB()

  Const WShtMastName As String = "SubSheetSrc"

  Dim WShtOrigName As String

  ' Save the active worksheet
  WShtOrigName = ActiveSheet.Name

  ' Make the master sheet active if it is not already active so
  ' you can see the different filtered as they are created.
  If WShtOrigName <> WShtMastName Then
    Sheets(WShtMastName).Activate
  End If

  ' Call CreateSubSheet for column 2 (=B) then column 4 (=D)

  Call CreateSubSheetB(WShtMastName, 2)
  Call MsgBox("Click to continue", vbOKOnly)
  Call CreateSubSheetB(WShtMastName, 4)
  Call MsgBox("Click to continue", vbOKOnly)
  With Sheets(WShtMastName)
    If .AutoFilterMode Then
      .AutoFilterMode = False
    End If
  End With

  ' Restore the original worksheet if necessary
  If WShtOrigName <> WShtMastName Then
    Sheets(WShtOrigName).Activate
  End If

End Sub

我假定您的工作簿位于服务器上。我假设有人有写权限来更新主工作表，而其他人则打开只读副本，以便查看他们感兴趣的子集。如果我的假设是正确的，那就拿一份工作簿给你玩。不要担心其他人更新工作簿的主版本，我们将在完成后从您的播放版本复制代码的最终版本

步骤1

将第一块代码复制到播放版本中的模块。在底部附近，您将看到

Const WShtMastName As String=“SubSheetSrc”

。用主工作表的名称替换子工作表RC

注意：此块中的宏被命名为

CtrlCreateSubSheetB

和

CreateSubSheetB

，因为它们是播放版本。真正的版本名为

CtrlCreateSubSheet

和

CreateSubSheet

运行宏CtrlCreateSubSheetB。您将看到主工作表，但仅显示B列中带有“X”的行。单击消息框。您将看到主工作表，但仅显示D列中带有“X”的行。单击消息框，过滤器将消失。如果还没有，请切换到VB编辑器。在即时窗口中（如果不可见，请单击

Ctrl

），您将看到如下内容：

Rows with X in column 2: $A$1:$G$2,$A$4:$G$5,$A$8:$G$9,$A$11:$G$12,$A$14:$G$14, ...
Rows with X in column 4: $A$1:$G$1,$A$3:$G$3,$A$5:$G$5,$A$7:$G$7,$A$10:$G$10, ...

现在，向下操作宏

CtrlCreateSubSheetB

和

CreateSubSheetB

。您必须了解这些宏是如何创建您所看到的效果的。如有必要，请使用VB帮助、调试器和

F8

来逐步删除宏，以确定每条语句正在执行的操作。我相信我已经给了你足够的信息，但如果有必要，我会带着问题回来

' Option Explicit means I have to declare every variable.  It stops
' spelling mistakes being taken as declarations of new variables.
Option Explicit

' Specify a subroutine with two parameters
Sub CreateSubSheetB(ByVal WShtSrcName As String, ByVal ColSrc As Long)

  ' This macro applies an AutoFilter based on column ColSrc
  ' to the worksheet named WShtSrcName

  Dim RngVis As Range

  With Sheets(WShtSrcName)
    If .AutoFilterMode Then
      ' AutoFilter is on.  Cancel current selection before applying
      ' new one because criteria are additive.
      .AutoFilterMode = False
    End If

    ' Make all rows which do not have an X in column ColSrc invisible
    .Cells.AutoFilter Field:=ColSrc, Criteria1:="X"

    ' Set the range RngVis to the union of all visible rows
    Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

  End With

  ' Output a string to the Immediate window.
  Debug.Print "Rows with X in column " & ColSrc & ": " & RngVis.Address

End Sub

' A macro to call CreateSubSheetB for different columns
Sub CtrlCreateSubSheetB()

  Const WShtMastName As String = "SubSheetSrc"

  Dim WShtOrigName As String

  ' Save the active worksheet
  WShtOrigName = ActiveSheet.Name

  ' Make the master sheet active if it is not already active so
  ' you can see the different filtered as they are created.
  If WShtOrigName <> WShtMastName Then
    Sheets(WShtMastName).Activate
  End If

  ' Call CreateSubSheet for column 2 (=B) then column 4 (=D)

  Call CreateSubSheetB(WShtMastName, 2)
  Call MsgBox("Click to continue", vbOKOnly)
  Call CreateSubSheetB(WShtMastName, 4)
  Call MsgBox("Click to continue", vbOKOnly)
  With Sheets(WShtMastName)
    If .AutoFilterMode Then
      .AutoFilterMode = False
    End If
  End With

  ' Restore the original worksheet if necessary
  If WShtOrigName <> WShtMastName Then
    Sheets(WShtOrigName).Activate
  End If

End Sub

步骤4

一旦您对宏进行了满意的去开发，您需要将包含宏的模块从播放版本复制到主版本。您可以先导出模块，然后再导入，但我认为以下操作更简单：

打开工作簿的播放版本和主版本
在主版本中创建一个空模块以保存宏
在播放版本中选择宏，将其复制到草稿行，然后将其粘贴到主版本中的空模块

您需要教会负责更新主版本的人在重要更新完成时运行宏。您可以使用快捷键或将宏添加到工具栏以使宏易于使用

摘要

希望一切都有意义。必要时一定要提问。

方法

' Option Explicit means I have to declare every variable. It stops ' spelling mistakes being taken as declarations of new variables. Option Explicit ' Specify a subroutine with two parameters Sub CreateSubSheetB(ByVal WShtSrcName As String, ByVal ColSrc As Long) ' This macro applies an AutoFilter based on column ColSrc ' to the worksheet named WShtSrcName Dim RngVis As Range With Sheets(WShtSrcName) If .AutoFilterMode Then ' AutoFilter is on. Cancel current selection before applying ' new one because criteria are additive. .AutoFilterMode = False End If ' Make all rows which do not have an X in column ColSrc invisible .Cells.AutoFilter Field:=ColSrc, Criteria1:="X" ' Set the range RngVis to the union of all visible rows Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible) End With ' Output a string to the Immediate window. Debug.Print "Rows with X in column " & ColSrc & ": " & RngVis.Address End Sub ' A macro to call CreateSubSheetB for different columns Sub CtrlCreateSubSheetB() Const WShtMastName As String = "SubSheetSrc" Dim WShtOrigName As String ' Save the active worksheet WShtOrigName = ActiveSheet.Name ' Make the master sheet active if it is not already active so ' you can see the different filtered as they are created. If WShtOrigName <> WShtMastName Then Sheets(WShtMastName).Activate End If ' Call CreateSubSheet for column 2 (=B) then column 4 (=D) Call CreateSubSheetB(WShtMastName, 2) Call MsgBox("Click to continue", vbOKOnly) Call CreateSubSheetB(WShtMastName, 4) Call MsgBox("Click to continue", vbOKOnly) With Sheets(WShtMastName) If .AutoFilterMode Then .AutoFilterMode = False End If End With ' Restore the original worksheet if necessary If WShtOrigName <> WShtMastName Then Sheets(WShtOrigName).Activate End If End Sub
我应该在我的答案的第一个版本中包含这一点
我的解决方案依赖于自动筛选。我首先提供了一个play解决方案，通过以下方式演示了这种方法：

使B列中不包含X的行不可见

使D列中不包含X的行不可见

清除自动过滤器
如果这种方法有吸引力，请参考我对另一个问题的回答，该问题创建了一个菜单，用户可以选择他们想要的过滤器
如果这种方法没有吸引力，我提供了第二种解决方案，它涉及将每个过滤器留下的可见行复制到其他工作表
导言
你说“我写宏的经验有限”，我认为这意味着你有一些经验。我希望我的解释水平是正确的。如果有必要，带着问题回来

' Option Explicit means I have to declare every variable. It stops ' spelling mistakes being taken as declarations of new variables. Option Explicit ' Specify a subroutine with two parameters Sub CreateSubSheetB(ByVal WShtSrcName As String, ByVal ColSrc As Long) ' This macro applies an AutoFilter based on column ColSrc ' to the worksheet named WShtSrcName Dim RngVis As Range With Sheets(WShtSrcName) If .AutoFilterMode Then ' AutoFilter is on. Cancel current selection before applying ' new one because criteria are additive. .AutoFilterMode = False End If ' Make all rows which do not have an X in column ColSrc invisible .Cells.AutoFilter Field:=ColSrc, Criteria1:="X" ' Set the range RngVis to the union of all visible rows Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible) End With ' Output a string to the Immediate window. Debug.Print "Rows with X in column " & ColSrc & ": " & RngVis.Address End Sub ' A macro to call CreateSubSheetB for different columns Sub CtrlCreateSubSheetB() Const WShtMastName As String = "SubSheetSrc" Dim WShtOrigName As String ' Save the active worksheet WShtOrigName = ActiveSheet.Name ' Make the master sheet active if it is not already active so ' you can see the different filtered as they are created. If WShtOrigName <> WShtMastName Then Sheets(WShtMastName).Activate End If ' Call CreateSubSheet for column 2 (=B) then column 4 (=D) Call CreateSubSheetB(WShtMastName, 2) Call MsgBox("Click to continue", vbOKOnly) Call CreateSubSheetB(WShtMastName, 4) Call MsgBox("Click to continue", vbOKOnly) With Sheets(WShtMastName) If .AutoFilterMode Then .AutoFilterMode = False End If End With ' Restore the original worksheet if necessary If WShtOrigName <> WShtMastName Then Sheets(WShtOrigName).Activate End If End Sub
我假定您的工作簿位于服务器上。我假设有人有写权限来更新主工作表，而其他人则打开只读副本，以便查看他们感兴趣的子集。如果我的假设是正确的，那就拿一份工作簿给你玩。不要担心其他人更新工作簿的主版本，我们将在完成后从您的播放版本复制代码的最终版本
步骤1
将第一块代码复制到播放版本中的模块。在底部附近，您将看到
Const WShtMastName As String=“SubSheetSrc”
。用主工作表的名称替换子工作表RC
注意：此块中的宏是a