"Worksheet_Change"；覆盖重新定位的行，并且无法处理列之间的间隙 [英] "Worksheet_Change" overwrites relocated rows and cannot handle gaps between columns

问题描述

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

I want to write a piece of VBA code in Sheet1 which reacts to changes made in a drop-down list in Excel.

现在，我编写了以下代码，其中Zeile = Row，并且下拉列表中的每个相关条目都可以在K7:K1007范围内找到.当设置为C(=已完成)时，相应的行应重定位到另一张名为Completed Items的工作表中.

For now, I have written the following code where Zeile = Row and every relevant entry in the drop-down list can be found within the range of K7:K1007. When set to C (= Completed), the respective row shall be relocated to another sheet, called 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的工作表是可行的.但是，仍然存在一些问题.

Moving a row from Sheet1 to a sheet called Completed Items works. But there are, however, still some problems left.

启动序列时，相应的行从Sheet1移动到Completed Items中的行7.但是，移动另一行将导致Completed Items中的覆盖行7.这是为什么?我试图更改Offset()选项，但到目前为止没有任何解决方法.

When initiating the sequence, the respective row is moved from Sheet1 to row 7 in Completed Items. Moving another row, however, will result in overwriting row 7 in Completed Items. Why is that? I have tried to change the Offset() option, but nothing has worked out so far.

我只想将1到11以及14到17的列从Sheet1迁移到Completed Items，以便将该范围从Sheet1的所有列都迁移到1到Completed Items中的15.但是，这不起作用，并且Sheet1的 all 列(1至17)都被重新定位到Completed Items.怎么了?

I just want to relocate columns 1 to 11 and 14 to 17 from Sheet1 to Completed Items so that everything in that range from Sheet1 is relocated to columns 1 to 15 in Completed Items. That, however, does not work and all columns (1 to 17) from Sheet1 are relocated to Completed Items. What is wrong?

推荐答案

始终覆盖覆盖重定位的行

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

Overwriting relocated rows all the time

You are determining the row to copy to by Cells(Rows.Count, 1).End(xlUp), which means the last cell in column A. Is it possible that the first cell in the copied row is empty?

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

To find the last row with data in any column there are multiple ways. The most reliable I have found is to use .Find to search for the last cell containing anything.

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更容易，但可能不可靠，因为删除单元格内容后它可能不会重置.

Using UsedRange is easier but might be unreliable because it might not reset after deleting cell contents.

Range(X,Y)返回同时包含X和Y的最小矩形范围，因此在您的情况下，它与Range(Cells(Zeile, 1), Cells(Zeile, 17))

Range(X,Y) returns the smallest rectangular range that contains both X and Y so in your case it's the same as Range(Cells(Zeile, 1), Cells(Zeile, 17))

顺便说一句，在这种情况下，您应该像对目的地一样指定工作表.

btw, you should specify the sheet in this case like you do with the destination.

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

As @bobajob already said, you can create ranges with multiple regions using Union, i.e. use Union(Range(Cells(Zeile, 1), Cells(Zeile, 11)), Range(Cells(Zeile, 14), Cells(Zeile, 17))).Copy

创建地址的另一种方法是使用地址(例如，第一行为"A1:K1，N1:Q1"):

Another way to create it would be using the address (for example "A1:K1,N1:Q1" for the first row):

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

但是，通常最好避免复制和粘贴(速度很慢)，而直接直接写入值.在您的情况下，可以使用

However it is often better to avoid copying and pasting (it's slow) and just write the values directly. In your case it could be done with

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"；覆盖重新定位的行，并且无法处理列之间的间隙的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！