Копирование активной ячейки в первую пустую ячейку из выбранного диапазона - PullRequest
0 голосов
/ 09 октября 2018

Дело в том, что: найти первую пустую ячейку в объявленном диапазоне.Если найдено, скопируйте значение из активной ячейки в «первую найденную пустую ячейку» и выйдите из цикла.

Не вижу, что должно быть улучшено.Возможно некоторые ошибки при выходе из цикла.

Sub Copie()
Dim myNamedRange As Range
Set myNamedRange = myWorksheet.Range("L2:L11")
For Each cell In myNamedRange
    If IsEmpty(cell) = True Then
        ActiveCell.Value = cell.Value
        Exit For
    End If
Next cell
End Sub

Ответы [ 2 ]

0 голосов
/ 09 октября 2018

Чтобы сделать это без зацикливания, вы можете использовать FIND, но это не даст никаких видимых улучшений при использовании небольшого диапазона.

Sub Copy()

    Dim myWorkSheet As Worksheet
    Dim myNamedRange As Range
    Dim FirstEmptyCell As Range

    Set myWorkSheet = ThisWorkbook.Worksheets("Sheet1")
    Set myNamedRange = myWorkSheet.Range("L2:L11")

    With myNamedRange
        Set FirstEmptyCell = .Find( _
            What:="", _
            After:=.Cells(.Rows.Count, .Columns.Count), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchDirection:=xlNext, _
            SearchFormat:=False)
    End With

    If Not FirstEmptyCell Is Nothing Then
        FirstEmptyCell = ActiveCell
    Else
        MsgBox "No empty cells found.", vbOKOnly + vbInformation
    End If

End Sub
0 голосов
/ 09 октября 2018

ActiveCell.Value = cell.Value должно быть cell.Value = ActiveCell.Value.

Левая часть заполнена правой частью.Посмотрите на этот небольшой пример:

Sub TestMe()        
    Dim a As Long
    Dim b As Long
    a = 10
    b = 20
    a = b
    MsgBox a 'shows 20, because it accepted "b"
End Sub

Таким образом, это должно работать:

Sub TestMe()

    Dim myNamedRange As Range
    Set myNamedRange = Worksheets(1).Range("L2:L11")
    Dim myCell As Range

    For Each myCell In myNamedRange
        If IsEmpty(myCell) Then
            myCell.Value = ActiveCell.Value
            Exit For
        End If
    Next myCell

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...