结合2个工作表更改 [英] Combining 2 worksheet changes

问题描述

我需要结合以下两个工作表更改。我不是那么有经验，也无法弄清楚

I need to combine the 2 following worksheet changes. I am not that experienced and cannot figure it out

私人子工作表_更改（按范围目标为ByVal）

如果Target.Column<> 8或Target.Cells.Count> 1然后退出Sub¥
Dim SortRange As Range

Set SortRange = Range（（"A1"），Cells（Rows.Count，8）.End（xlUp））

SortRange.Sort Key1：=范围（"H2"），Order1：= xlAscending，Header：= xlYes

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 8 Or Target.Cells.Count > 1 Then Exit Sub
Dim SortRange As Range
Set SortRange = Range(("A1"), Cells(Rows.Count, 8).End(xlUp))
SortRange.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlYes
End Sub

Private Sub Worksheet_Change（ByVal Target As Range）

 昏暗的C作为范围

 如果Intersect（目标，Me.Range（"D：D"））是Nothing然后退出Sub¥
 对于每个C在相交（目标，Me.Range（"D：D"））。细胞

   如果C.Text ="y"，然后是
      C.EntireRow.Copy工作表（"Shipped"）。Cells（Rows.Count，"D"）。End（xlUp）.Offset（1）.EntireRow

    &NBSP;&NBSP; C.EntireRow.Delete

   结束如果

 下一个

结束子

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim C As Range
  If Intersect(Target, Me.Range("D:D")) Is Nothing Then Exit Sub
  For Each C In Intersect(Target, Me.Range("D:D")).Cells
    If C.Text = "y" Then
      C.EntireRow.Copy Worksheets("Shipped").Cells(Rows.Count, "D").End(xlUp).Offset(1).EntireRow
      C.EntireRow.Delete
    End If
  Next
End Sub

推荐答案

你基本上把每一个都包裹在一个条件中，将条件反转用来退出Sub

You basically wrap each one in a conditional, reversing the conditions use to Exit Sub

例如：

  &NBSP;如果Target.Column<> 8或Target.Cells.Count> 1然后退出子

变为

  &NBSP;如果Target.Column = 8而Target.Cells.Count = 1那么

    If Target.Column = 8 And Target.Cells.Count = 1 Then

（也可能是：

   if Not （Target.Column<> 8或Target.Cells.Count> 1）然后

但我不喜欢这种逻辑因为它更难阅读/理解。）

所以，总之，我们使用：

So, all together, we use:

Private Sub Worksheet_Change（ByVal Target As Range）

  &NBSP;昏暗的C作为范围

  &NBSP; Dim SortRange作为范围



  &NBSP;如果Target.Column = 8而Target.Cells.Count = 1则为
  &NBSP; &NBSP; &NBSP;设置SortRange = Range（（"A1"），Cells（Rows.Count，8）.End（xlUp））

  &NBSP; &NBSP; &NBSP; SortRange.Sort Key1：= Range（" H2"），Order1：= xlAscending，Header：= xlYes

  &NBSP;结束如果



  &NBSP;如果不相交（目标，Me.Range（"D：D"））则为Nothing然后为
  &NBSP; &NBSP; &NBSP;对于每个C在相交中（目标，Me.Range（"D：D"））。单位格
  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;如果C.Text ="y"，然后

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; C.EntireRow.Copy工作表（"Shipped"）。Cells（Rows.Count，"D"）。End（xlUp）.Offset（1）.EntireRow

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; C.EntireRow.Delete

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;结束如果

  &NBSP; &NBSP; &NBSP;下一个

  &NBSP;结束如果

结束子

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim C As Range
    Dim SortRange As Range

    If Target.Column = 8 And Target.Cells.Count = 1 Then
        Set SortRange = Range(("A1"), Cells(Rows.Count, 8).End(xlUp))
        SortRange.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlYes
    End If

    If Not Intersect(Target, Me.Range("D:D")) Is Nothing Then
        For Each C In Intersect(Target, Me.Range("D:D")).Cells
            If C.Text = "y" Then
                C.EntireRow.Copy Worksheets("Shipped").Cells(Rows.Count, "D").End(xlUp).Offset(1).EntireRow
                C.EntireRow.Delete
            End If
        Next
    End If
End Sub

您还应注意VBA区分大小写 - 因此您可能想要更改

You should also note that VBA is case sensitive - so you may want to change

 如果C.Text =" y"那么

 If C.Text = "y" Then

到

 如果LCase（C.Text）=" y"然后是

 If LCase(C.Text) = "y" Then

这篇关于结合2个工作表更改的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！