我想在Sheet1编写一段VBA代码，它对Excel中下拉列表中所做的更改做出反应。
现在，我编写了以下代码，其中Zeile = Row ，下拉列表中的每个相关条目都可以在K7:K1007的范围内找到。 设置为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一直覆盖重定位的行
启动序列时，相应的行将从“ Completed Items Sheet1移动到第7行。 但是，移动另一行将导致覆盖 Completed Items第7行。 这是为什么？ 我试图更改Offset()选项，但到目前为止还没有任何结果。
VBA无法处理第11列和第14列之间的差距
我只想将第1列到第11和第14列从第1列重新定位到Completed Items以便将Sheet1范围内的所有内容重新定位到Completed Items 1列到第15列。 但是，这不起作用， Sheet1中的所有列（ 1到17 ）都重新定位到Completed Items 。 哪里不对？
I want to write a piece of VBA code in Sheet1 which reacts to changes made in a drop-down list in Excel.
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 SubOverwriting relocated rows all the time
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.
VBA cannot handle the gap between column 11 and 14
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列中的最后一个单元格。复制行中的第一个单元格是否可能为空？
要在任何列中查找包含数据的最后一行，有多种方法。 我发现最可靠的是使用.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创建多个区域的范围，即使用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)).ValueOverwriting 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?
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 FunctionUsing UsedRange is easier but might be unreliable because it might not reset after deleting cell contents.
VBA cannot handle the gap between column 11 and 14
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.
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
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更多推荐
发布评论