Excel VBA: если выбранная ячейка пуста - PullRequest
0 голосов
/ 29 марта 2020

Надеюсь, у вас все хорошо.

Итак, я работаю над макросом в Excel, цель состоит в том, чтобы скопировать и вставить ячейку x последнего добавленного столбца, зная, что каждый день добавляется столбец, пока не будет достигнут столбец «AX».

Таким образом, у меня была идея проверить, является ли последний столбец (AX) пустым, если да, то я двигаюсь влево с 3 столбцами, затем снова делаю то же самое, если он пуст, перемещаем в другой раз с 3 столбцами, чтобы слева, пока он не найдет полную ячейку, затем выполните процесс копирования и вставки.

Проблема в том, что я не знаю, как определить l oop, чтобы продолжать выполнять проверку, пока он не найдет полную ячейку.

Мой код на данный момент:

Sub Test_FM()
Application.ScreenUpdating = False
x = 0
Sheets("Test FM").Select
Range("AX9").Select
If ActiveCell.Value = "" Then
Range("AX9").Activate
ActiveCell.Offset(rowoffset:=0, columnoffset:=x).Activate
x = x - 3
Range("AX9").Select
ActiveCell.Offset(rowoffset:=x, columnoffset:=0).Activate
ActiveSheet.Rows(ActiveCell.Row).Select
Range("AX9").Select
Range("AX9").Activate
ActiveCell.Offset(rowoffset:=x, columnoffset:=0).Activate
Selection.Copy
Sheets("DR 02").Select
Range("M19").Select
Selection.PasteSpecial

ElseIf 
IsEmpty(ActiveCell) = False Then
Sheets("Test FM").Select
Range("AX9").Select
Range("AX9").Activate
ActiveCell.Offset(rowoffset:=x, columnoffset:=0).Activate
Selection.Copy
Sheets("DR 02").Select
Range("M19").Select
Selection.PasteSpecial
End IF
End Sub

Спасибо

1 Ответ

1 голос
/ 29 марта 2020

Просто используйте смещение

Sub Test_FM()

    Dim wb As Workbook, ws As Worksheet, wsTarget As Worksheet, cell As Range
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Test FM")
    Set wsTarget = wb.Sheets("DR 02")

    Set cell = ws.Range("AX9")
    Do While Len(cell.Value) = 0
        If cell.Column < 4 Then Exit Do
        Set cell = cell.Offset(0, -3) ' move 3 cols to left
    Loop

    If Len(cell.Value) = 0 Then
        MsgBox "All columns empty up to " & cell.Address, vbCritical
    Else
        cell.Copy
        wsTarget.Range("M19").PasteSpecial
        MsgBox cell.Address & " copied to M19 on " & wsTarget.Name, vbInformation
    End If

End Sub

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