Excel VBA, как выбрать строки на основе данных в столбце? - PullRequest
4 голосов
/ 20 марта 2012
Sub SelectAllReleventText()
Do While Range(“A1”).Offset(1, 6) <> Empty
Rows(ActiveCell.Row).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Вот мой сценарий, мне сказали, что он не выполняет то, для чего он предназначен, чего я ожидал, так как это была моя первая попытка.Я приду с переменной не определена ошибка.Я думал, что определил переменную, но я думаю, что это не было достаточно конкретно для Excel VBA.

Это то, что я пытаюсь сделать.

  1. В Рабочей книге 1, на B6 есть буквенно-цифровое имя, я хочу, чтобы эта строка была выбрана.
  2. Пройдите вниз на одну строку, если там есть текст, выберите эту строку.
  3. Продолжайте, пока текст больше не будет распространен.
  4. Скопировать выбранные строки.
  5. Вставить в другую рабочую книгу (Workbook2) на вкладку 1, начиная со строки 2, так как строка 1 имеет заголовки.

Спасибо вавансовый.Просто напоследок, я использую параметры Explicit в своем VBA, потому что мне сказали, что это «правильный способ сделать что-то» ...

Ответы [ 2 ]

10 голосов
/ 20 марта 2012

Да, использование 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

ПРИМЕЧАНИЕ

Если у вас есть данные со строки 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

Надеюсь, это то, что вы хотели?

Sid

3 голосов
/ 20 марта 2012

Самый простой способ сделать это - использовать метод End, который дает вам ячейку, которую вы достигаете, нажимая клавишу завершения, а затем направление, когда вы находитесь в ячейке (в данном случае B6).Это не даст вам того, что вы ожидаете, если B6 или B7 пустые.

Dim start_cell As Range
Set start_cell = Range("[Workbook1.xlsx]Sheet1!B6")
Range(start_cell, start_cell.End(xlDown)).Copy Range("[Workbook2.xlsx]Sheet1!A2")

Если вы не можете использовать End, то вам придется использовать цикл.

Dim start_cell As Range, end_cell As Range

Set start_cell = Range("[Workbook1.xlsx]Sheet1!B6")
Set end_cell = start_cell

Do Until IsEmpty(end_cell.Offset(1, 0))
    Set end_cell = end_cell.Offset(1, 0)
Loop

Range(start_cell, end_cell).Copy Range("[Workbook2.xlsx]Sheet1!A2")
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...