"Worksheet_Change" 覆盖重新定位的行并且无法处理列之间的间隙

Question

我想在 Sheet1 中编写一段 VBA 代码，它对 Excel 中下拉列表中所做的更改做出反应。

目前，我编写了以下代码，其中 Zeile = Row 并且下拉列表中的每个相关条目都可以在 K7:K1007 范围内找到。当设置为 C（= 已完成）时，相应的行应重新定位到另一个 sheet，称为 Completed Items。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Zeile As Long
    Set Target = Intersect(Target, Range("K7:K1007"))
    If Target Is Nothing Then Exit Sub
    If Target = "C" Then
        Zeile = Target.Row
        Range(Range(Cells(Zeile, 1), Cells(Zeile, 11)), _
        Range(Cells(Zeile, 14), Cells(Zeile, 17))).Copy _
        Destination:=Sheets("Completed Items").Cells(Rows.Count, 1).End(xlUp).Offset(6, 0)
        Target.EntireRow.Delete
    End If
End Sub

将行从 Sheet1 移动到名为 Completed Items 的 sheet 行。但是，仍然存在一些问题。

始终覆盖重定位的行

启动序列时，相应行从 Sheet1 移动到 Completed Items 中的行 7。但是，移动另一行将导致覆盖行 7 in Completed Items。这是为什么？我尝试更改 Offset() 选项，但到目前为止没有任何效果。

VBA 无法处理列 `11` 和 `14`

之间的间隙

我只想将列 1 重定位到 11 并将 14 重定位到 17 从 Sheet1 到 Completed Items 以便所有内容Sheet1 的范围被重新定位到 Completed Items 中的 1 到 15 列。但是，这不起作用，Sheet1 中的所有列（1 到 17）被重新定位到 Completed Items。怎么了？

Answer 1

如@arcadeprecinct 所述，第一个问题很可能是因为您正在复制的第一行的 A 列中缺少值。

第二个问题是由于您如何定义范围 - 将两个范围作为参数传递给另一个范围将 return 这两个范围的凸包，而不是它们的不相交联合。尝试

Application.Union(Range(Cells(Zeile, 1), Cells(Zeile, 11)), Range(Cells(Zeile, 14), Cells(Zeile, 17))).Copy

相反。

Answer 2

一直覆盖重定位的行

您正在确定要复制到的行 Cells(Rows.Count, 1).End(xlUp)，这意味着 A 列中的最后一个单元格。复制行中的第一个单元格是否可能为空？

要查找任何列中包含数据的最后一行，有多种方法。我发现最可靠的方法是使用 .Find 搜索包含任何内容的最后一个单元格。

Function findLastRow(sh As Worksheet) As Long
    Dim tmpRng As Range 'need to use temporary range object in case nothing is found. (Trying to access .Row of Nothing causes error)

    Set tmpRng = sh.Cells.Find(What:="*", _
        After:=sh.Cells(1), _
        LookIn:=xlValues, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious)
    If Not tmpRng Is Nothing Then
        findLastRow = tmpRng.Row
    Else
        findLastRow = 1
    End If
End Function

使用 UsedRange 更容易，但可能不可靠，因为删除单元格内容后它可能不会重置。

VBA 无法处理第 11 列和第 14 列之间的空隙

Range(X,Y) returns 包含 X 和 Y 的最小矩形范围，因此在您的情况下它与 Range(Cells(Zeile, 1), Cells(Zeile, 17))[=22= 相同]

顺便说一句，在这种情况下，您应该像处理目的地一样指定 sheet。

正如@bobajob 已经说过的，您可以使用 Union 创建具有多个区域的范围，即使用 Union(Range(Cells(Zeile, 1), Cells(Zeile, 11)), Range(Cells(Zeile, 14), Cells(Zeile, 17))).Copy

创建它的另一种方法是使用地址（例如第一行的 "A1:K1,N1:Q1"）：

Range("A" & Zeile & ":K" & Zeile & ",N" & Zeile & ":Q" & Zeile).Copy

然而，最好避免复制和粘贴（速度很慢），而直接写入值。在你的情况下，它可以用

来完成

Dim sh1 As Worksheet  'where to copy from
Dim sh2 As Worksheet  'where to copy to
Dim zielZeile As Long 'which row to copy to

Set sh1 = ThisWorkbook.Worksheets("sheetnamehere")
Set sh2 = ThisWorkbook.Worksheets("Completed Items")

'...
'set the row where to copy
zielZeile = findLastRow(sh2) + 6
'write to columns 1 to 11
sh2.Range(sh2.Cells(zielZeile, 1), sh2.Cells(zielZeile, 11)).Value = sh1.Range(sh1.Cells(Zeile, 1), sh1.Cells(Zeile, 11)).Value
'write to columns 12 to 115
sh2.Range(sh2.Cells(zielZeile, 12), sh2.Cells(zielZeile, 15)).Value = sh1.Range(sh1.Cells(Zeile, 14), sh1.Cells(Zeile, 17)).Value

"Worksheet_Change" 覆盖重新定位的行并且无法处理列之间的间隙

"Worksheet_Change" overwrites relocated rows and cannot handle gaps between columns

excel

vba

filter

worksheet-function

始终覆盖重定位的行

VBA 无法处理列 `11` 和 `14`

一直覆盖重定位的行

VBA 无法处理第 11 列和第 14 列之间的空隙

"Worksheet_Change" 覆盖重新定位的行并且无法处理列之间的间隙

"Worksheet_Change" overwrites relocated rows and cannot handle gaps between columns

excel

vba

filter

worksheet-function

始终覆盖重定位的行

VBA 无法处理列 11 和 14

一直覆盖重定位的行

VBA 无法处理第 11 列和第 14 列之间的空隙

VBA 无法处理列 `11` 和 `14`