“Worksheet_Change”会覆盖重定位的行，无法处理列之间的间隙
我想在Sheet1写一块VBA代码，它对Excel中下拉列表中所做的更改作出反应。
现在，我写了下面的代码，其中Zeile = Row ，下拉列表中的每个相关条目都可以在K7:K1007范围内find。 设置为C （=已完成）时，相应的行应重新定位到另一个表单，称为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工作表中。 但是，还有一些问题还没有解决。
一直覆盖重新定位的行
启动序列时，相应的行将从Sheet1移至Completed Items第7行。 但是，移动另一行将导致覆盖 Completed Items第7行。 这是为什么？ 我试图改变Offset()选项，但到目前为止没有任何解决办法。
VBA无法处理第11栏和第14栏之间的差距
我只想将Sheet1 1列到第11列和第14到第17列重新定位到“ Completed Items以便将Sheet1范围内的所有内容重新定位到“ Completed Items 1列到第15列。 但是，这不起作用， Sheet1中的所有列（ 1到17 ）都被重新定位到“ Completed Items 。 哪里不对？
一直覆盖重新定位的行
您正在通过Cells(Rows.Count, 1).End(xlUp)来确定要复制的行，这意味着列A中的最后一个单元格。复制行中的第一个单元格是否可能是空的？
要find任何列中的最后一行数据，有多种方法。 我find的最可靠的就是使用。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)返回包含X和Y的最小矩形范围，所以在这种情况下它与Range(Cells(Zeile, 1), Cells(Zeile, 17))
顺便说一句，你应该在这种情况下指定工作表，就像你做的目的地。
正如@bobajob已经说过的，你可以使用Union(Range(Cells(Zeile, 1), Cells(Zeile, 11)), Range(Cells(Zeile, 14), Cells(Zeile, 17))).Copy
另一种创build方法是使用地址（例如“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
正如@arcadeprecinct提到的，第一个问题很可能是因为您正在复制的第一行A列中缺less值。
第二个问题是由于你如何定义你的范围 – 传递两个范围作为另一个范围的参数将返回这两个范围的凸包，而不是它们不相交的联合。 尝试
Application.Union(Range(Cells(Zeile, 1), Cells(Zeile, 11)), Range(Cells(Zeile, 14), Cells(Zeile, 17))).Copy
代替。