Вырезать и вставить значение ячейки в другую ячейку в VBA - PullRequest
0 голосов
/ 23 октября 2018

Мне нужно перенести или переместить значение столбца F до последней ячейки со значением в столбец D, если столбец C равен «RRR».Я не могу выделить или выбрать диапазон, начиная с местоположения «RRR» и заканчивая последней ячейкой со значением «SSS».Вместо этого он выбирает диапазон из C4: C9, который является неправильным.

    Dim ws As Worksheet, lRow As Long

Set ws = ThisWorkbook.ActiveSheet
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

Dim lCol As Long

With ws
    For x = 1 To lRow
        If .Cells(x, 3).Value = "RRR" Then
            lCol = Cells(x, Columns.Count).End(xlToLeft).Column
            Range("C" & x & ":C" & lCol).Select
        End If
    Next x
End With

Пример: enter image description here

Ожидаемый:

enter image description here

Может кто-нибудь сказать мне проблему в моем коде.

Ответы [ 2 ]

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

Альтернативным методом будет удаление ячеек в столбцах D и E

Dim ws As Worksheet, lRow As Long
Dim x As Long

    Set ws = ThisWorkbook.ActiveSheet
    lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

    Dim lCol As Long

    With ws
        For x = 1 To lRow
            If .Cells(x, 3).Value = "RRR" Then .Range("C" & x & ":D" & x).Delete Shift:=xlToLeft
            End If
        Next x
    End With

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

Вы очень близко, только выбранный диапазон, который должен быть изменен.

Таким образом, вы можете построить свой диапазон:

Range(A1:D1) -> Range(Cells(A1), Cells(D1)) -> 

Range(Cells(row number, column number), Cells(row number, column number)) -> 

Range(Cells(1, 1), Cells(1, 4))

Это должно помочь:

Dim ws As Worksheet, lRow As Long
Dim x As Long

Set ws = ThisWorkbook.ActiveSheet
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

Dim lCol As Long

With ws
    For x = 1 To lRow
        If .Cells(x, 3).Value = "RRR" Then
            lCol = Cells(x, Columns.Count).End(xlToLeft).Column 'Find the last column number
            Range(Cells(x, 6), Cells(x, lCol)).Cut Cells(x, 4) 'Cut from row x and Column F (Column F = 6) to row x and column "lCol". Then paste the range into row x and column 4.
        End If
    Next x
End With

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