4

我将尽量保持简短，并且仍然充分解释，这里是:)

我搜索了论坛、我的 VBA 文献，但找不到一种方法来做我正在尝试的事情。

我有一个 rowTotal >= 60 行的电子表格。这些行在每列的单元格中都有文本数据，或者这些行是空白的，带有图案和颜色索引集。

我需要一个宏来选择所有非空行。

我首先尝试遍历 A 列的单元格（如果 A 列中的单元格有文本数据，则应选择其行），检查activecell.value<> 是否为空。

这是 jist（伪代码和代码的混合）：

Range("A1").Select
loop to end
  if activeCell.value <> empty then 
    stringVar = stringVar + cstr(activeCell.row) + ":" + cstr(activeCell.row) + ","
  end if 
end loop

stringVar = Left(stringVar, (Len(stringVar) - 1))
Range(stringVar).Select

  1. 如果我总共有 10 行，第 2 行和第 8 行有数据，stringVar会解决这个问题："2:2, 8:8".
    Range(stringVar).Select将具有与 write 相同的结果Range("2:2, 8:8").Select。

  2. 如果要在该范围内的行数 <= 45，则这没有问题。但是，只要其中包含数据的行数超过 45，代码就会在Range(stringVar).Select.

我尝试了宏记录器，它通过使用该Union方法解决了这个问题。所以我想，“你自己，你可以用 Union() 完成这个。万岁 MacroRecorder。” 但可惜，我的快乐是疏忽。
我在想我可以把一根大弦分成1根或多根；这些较小的字符串中的每一个都将低于上述 45 个限制。然后我可以使用 Union() 将所有范围（这些较小的字符串）组合到一个所需的范围中。

但是，在我知道我拥有这45> 个字符串中有多少之后，我必须在代码执行期间实时“构建”我的 Union() 代码。

任何人都知道如何获取工作表并仅选择包含数据的行；这相当于有一系列不连续的行，其中选择了超过 45 行。

4

3 回答 3

7

不需要循环 - 使用SpecialCells

仅对于 A 列使用：

Set rng1 = Columns("A").SpecialCells(xlCellTypeConstants).EntireRow

反而。

Sub QuickSet()

  Dim rng1 As Range

  On Error Resume Next
  Set rng1 = Cells.SpecialCells(xlCellTypeConstants).EntireRow
  On Error GoTo 0

  If Not rng1 Is Nothing Then
    MsgBox "Your working range is " & rng1.Address(0, 0)
  Else
    MsgBox "No constants found"
  End If

End Sub
于 2013-01-09T06:32:14.917 回答
2

我首先建议您尝试使用 Autofilter。如果您使用的是 Excel 2010（和 prob 2007，但我无法检查），这就像选择您的数据，选择“数据”选项卡，然后单击过滤器一样简单。使用第一列中的下拉框，取消选择“空白”。

Excel 2003 中的数据/过滤器菜单选项下存在完全相同的功能。不过，我真的记不太清了。你必须进行实验，或者谷歌它。

如果这不起作用：

Sub it()

    Dim cell As Range
    Dim selectRange As Range

    For Each cell In ActiveSheet.Range("A:A")
        If (cell.Value <> "") Then
            If selectRange Is Nothing Then
                Set selectRange = cell
            Else
                Set selectRange = Union(cell, selectRange)
            End If
        End If
    Next cell

    selectRange.Select
    ' selectRange.EntireRow.Select 'If you want to select entire rows

End Sub
于 2013-01-09T04:24:59.417 回答
1

刚刚使用了这段代码，它奏效了——一直在跟踪所有其他 excel 论坛，但找不到任何被简化的东西。

我还补充说，如果有人觉得这很有用，选定的行将被复制并粘贴到另一张工作表中的下一个空白行。

Sub copypaste1()

    'Find rows that contain any value in column A and copy them
    Dim cell As Range
    Dim selectRange As Range

    For Each cell In ActiveSheet.Range("A:A")
        If (cell.Value <> "") Then
            If selectRange Is Nothing Then
                Set selectRange = cell
            Else
                Set selectRange = Union(cell, selectRange)
            End If
        End If
    Next cell

    selectRange.EntireRow.Select
    selectRange.EntireRow.Copy

    'Paste copied selection to the worksheet 'mega' on the next blank row
    Sheets("mega").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
         Paste:=xlPasteValues

End Sub
于 2013-06-18T09:40:16.250 回答