Excel VBA,如何根据列中的数据选择行?

Mat*_*dge 4 excel vba excel-vba

Sub SelectAllReleventText()
Do While Range(“A1”).Offset(1, 6) <> Empty
Rows(ActiveCell.Row).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Run Code Online (Sandbox Code Playgroud)

这是我的剧本,我被告知它没有做到它的意思,这是我的预期,因为这是我的第一次尝试.我想出一个未定义错误的变量.我以为我定义了变量,但我猜它对Excel VBA来说不够具体.

这就是我想要做的.

  1. 在工作簿1中,在B6上有一个字母数字名称,我希望选择该行.
  2. 向下一行,如果有文本,则选择该行.
  3. 继续,直到文字不再流行.
  4. 复制选定的行.
  5. 粘贴到另一个工作簿(Workbook2),从第2行开始,进入选项卡1,因为第1行有标题.

提前致谢.只是一个抬头,我在我的VBA中使用选项明确,因为有人告诉我这是"做事的正确方法"......

Sid*_*out 10

是的使用Option Explicit是一个好习惯..Select然而,使用不是:)它降低了代码的速度.同样完全证明工作表名称,否则代码将始终运行,Activesheet这可能不是您真正想要的.

这是你在尝试什么?

Option Explicit

Sub Sample()
    Dim lastRow As Long, i As Long
    Dim CopyRange As Range

    '~~> Change Sheet1 to relevant sheet name
    With Sheets("Sheet1")
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To lastRow
            If Len(Trim(.Range("A" & i).Value)) <> 0 Then
                If CopyRange Is Nothing Then
                    Set CopyRange = .Rows(i)
                Else
                    Set CopyRange = Union(CopyRange, .Rows(i))
                End If
            Else
                Exit For
            End If
        Next

        If Not CopyRange Is Nothing Then
            '~~> Change Sheet2 to relevant sheet name
            CopyRange.Copy Sheets("Sheet2").Rows(1)
        End If
    End With
End Sub
Run Code Online (Sandbox Code Playgroud)

注意

如果你有第2行到第10行的数据,第11行是空白,那么你从第12行再次获得数据,那么上面的代码只会复制第2行的数据直到第10行

如果要复制所有包含数据的行,请使用此代码.

Option Explicit

Sub Sample()
    Dim lastRow As Long, i As Long
    Dim CopyRange As Range

    '~~> Change Sheet1 to relevant sheet name
    With Sheets("Sheet1")
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To lastRow
            If Len(Trim(.Range("A" & i).Value)) <> 0 Then
                If CopyRange Is Nothing Then
                    Set CopyRange = .Rows(i)
                Else
                    Set CopyRange = Union(CopyRange, .Rows(i))
                End If
            End If
        Next

        If Not CopyRange Is Nothing Then
            '~~> Change Sheet2 to relevant sheet name
            CopyRange.Copy Sheets("Sheet2").Rows(1)
        End If
    End With
End Sub
Run Code Online (Sandbox Code Playgroud)

希望这是你想要的?

希德