【问题标题】:Cut and paste row if columns AC-AF contain blanks如果 AC-AF 列包含空白,则剪切并粘贴行
【发布时间】:2018-12-11 21:24:41
【问题描述】:

我想要完成的是:
如果我的整个工作表中的 AC-AF 列中的任何单元格为空白,请剪切整行并粘贴到标有“MissingShipping”的新工作表中。
代码应该根据行数进行调整,因为这永远不会相同。

从我看到的示例中,我不明白在哪里插入我想要遍历的单元格范围。

我得到了错误

"对象'_Worksheet'的方法'范围'

上线NewSetup.Range(Cells(Destinationrow, 1), Cells(Destinationrow, lastcolumn)).Select

Option Explicit
Sub Shipping()
    Dim MissingShipping As Worksheet
    Set MissingShipping = Sheets.Add(After:=Sheets(Sheets.Count))
    MissingShipping.Name = "MissingShipping"
    Dim NewSetup As Worksheet
    Dim lastcolumn As Integer
    Dim Destinationrow As Integer
    Dim lastrow As Long
    Set NewSetup = Worksheets("NKItemBuildInfoResults")
    Set MissingShipping = Worksheets("MissingShipping")
    Destinationrow = 1
    lastcolumn = NewSetup.Range("XFD1").End(xlToLeft).Column
    lastrow = NewSetup.Range("A1048576").End(xlUp).Row
    Dim i As Long
    Dim j As Long
    For i = lastrow To 1 Step -1
        For j = 1 To lastcolumn
            If NewSetup.Cells(i, j).Value = "" Then
                NewSetup.Activate
                NewSetup.Range(Cells(i, 1), Cells(i, lastcolumn)).Cut
                MissingShipping.Activate
                NewSetup.Range(Cells(Destinationrow, 1), Cells(Destinationrow, _
                  lastcolumn)).Select
                ActiveSheet.Paste
                NewSetup.Rows(i).Delete shift:=xlUp
                Destinationrow = Destinationrow + 1
                Exit For
            End If
        Next j
    Next i
End Sub

【问题讨论】:

  • 该错误可能是由于在另一个工作表处于活动状态(在上一行激活)时尝试选择一个工作表上的单元格。如果可能,您应该尽量避免使用.SelectActive... 任何东西(即工作簿、工作表等)。例如,您可以只使用MissingShipping.Paste,而不是使用MissingShipping.Activate 后跟ActiveSheet.Paste
  • 学习 VBA 的良好开端!为了帮助您进一步了解,请阅读this answer on avoiding the use of Select
  • 感谢您的帮助!我删除了 .Select 和 .Active 但我仍然在“NewSetup.Range(Cells(i, 1), Cells(i, lastcolumn) 行上收到错误“对象'_Worksheet'的方法'范围'失败” ).Cut".. 我注意到,每当必须在两个工作表之间切换时,我总是会遇到麻烦。我是否缺少指向正确工作表的内容?

标签: arrays excel vba if-statement worksheet


【解决方案1】:

G'day Nikki,

欢迎来到 VBA 的世界!互联网上有很多很棒的资源可以帮助您完成旅程。

在代码中使用范围通常比在工作表中读取和写入并选择单元格来模仿您在手动执行工作时通常会做的事情更容易和更快。

尽早让你的头脑围绕范围对象是个好主意。处理多个工作表很方便。

以下是 Excel 中范围的良好开端:

https://excelmacromastery.com/excel-vba-range-cells/

另一个方便的东西是集合。如果您必须存储一堆东西以供以后使用,您可以将它们添加到集合中,然后使用“For Each”循环遍历它们。这是对集合的一个很好的解释:

https://excelmacromastery.com/excel-vba-collections/

我快速查看了您的代码并使用范围和集合的概念,我已经对其进行了更改,以完成我认为您正在尝试做的事情。我不得不做出一些假设,因为我还没有看到你的表格。我在计算机上的一堆随机行上运行代码以确保它有效。考虑以下几点:

Dim MissingShipping As Worksheet
Dim NewSetup As Worksheet

Dim rangeToCheck As Range
Dim cellsToCheck As Range
Dim targetRange As Range
Dim rw As Range 'rw is a row
Dim cl As Range 'cl is a cell

Dim rowColl As New Collection

Dim i As Long

Set NewSetup = Worksheets("NKItemBuildInfoResults")
Set MissingShipping = Worksheets("MissingShipping")

'Get the range of data to check
Set rangeToCheck = NewSetup.Range("A1").CurrentRegion

'For each row in the range
For Each rw In rangeToCheck.Rows

    'For the last four cells in that row
    Set cellsToCheck = rw.Cells(1, 29).Resize(1, 4)

    For Each cl In cellsToCheck.Cells

        'If the cell is empty
        If cl.Value = "" Then

            'Add the row to our collection of rows
            rowColl.Add rw

            'Exit the for loop because we only want to add the row once.
            'There may be multiple empty cells.
            Exit For

        End If

    'Check the next cell
    Next cl

Next rw

'Now we have a collection of rows that meet the requirements that you were after

'Using the size collection of rows we made, we now know the size of the range 
'we need to store the values
'We can set the size of the new range using rowColl.Count 
'(that's the number of rows we have)
Set targetRange = MissingShipping.Range("A1").Resize(rowColl.Count, 32)

'Use i to step through the rows of our new range
i = 1

'For each row in our collection of rows
For Each rw In rowColl

    'Use i to set the correct row in our target range an make it's value 
    'equal to the row we're looking at
    targetRange.Rows(i) = rw.Value

    'Increment i for next time
    i = i + 1

Next rw

End Sub

祝你好运!希望这会有所帮助。

【讨论】:

  • 这就像一场梦!非常感谢,非常感谢您花时间解释代码。这对我帮助很大!
  • 不用担心,很高兴我能帮上忙。祝你编码顺利!
猜你喜欢
  • 1970-01-01
  • 2020-08-18
  • 2020-11-02
  • 1970-01-01
  • 2016-11-30
  • 2021-10-06
  • 2020-12-16
  • 1970-01-01
  • 2018-03-17
相关资源
最近更新 更多