Копирование значения последнего столбца в строке в excel vba

avatar
Arkaelum
1 июля 2021 в 17:24
115
2
0

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

Dim lastrow As Long, i As Long
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
For i = 2 To lastrow
    Range("a" & i).End(xlToRight).Copy
    Range("a" & i).End(xlToLeft).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
Next i

Мне нужно, чтобы A2 скопировал значение последнего столбца необработанных данных, которое находится в D2 (электронная почта). Затем A3 скопирует значение последнего столбца своей строки, которое равно C3 (электронная почта)

.

Спасибо

Источник

Ответы (2)

avatar
jamheadart
1 июля 2021 в 18:57
0

Это можно сделать с помощью одних только формул:

=IFERROR(INDIRECT(ADDRESS(ROW(),SUMPRODUCT(MAX(COLUMN(B2:F2)*(B2:F2<>""))))),"")

где эта формула вставлена ​​в A2 и заполнена всеми желтыми ячейками:

enter image description here

Если вы действительно хотите использовать VBA, вы все равно можете использовать формулу и просто вставлять значения, чтобы избежать зацикливания!

Sub eh()
Dim lRow As Long: lRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
Sheet1.Range("A2:A" & lRow).Formula = _
    "=IFERROR(INDIRECT(ADDRESS(ROW(),SUMPRODUCT(MAX(COLUMN(B2:F2)*(B2:F2<>""""))))),"""")"
Sheet1.Range("A2:A" & lRow).Value2 = Sheet1.Range("A2:A" & lRow).Value2
End Sub

Хотя меня смущает то, как ваш расчет lastRow получает последнюю строку в столбце A, когда столбец A еще не заполнен...

Arkaelum
1 июля 2021 в 19:04
0

LastRow будет работать только в том случае, если в конце столбца A есть значение, поэтому я просто поместил туда случайное значение. Однако на самом деле это всего лишь часть всего проекта, над которым я работаю, и в конце всегда есть данные.

BigBen
1 июля 2021 в 19:32
0

Дополнительное примечание: вероятно, лучше избегать косвенных, поскольку они изменчивы.

avatar
Arkaelum
1 июля 2021 в 18:45
0

Удалось получить ответ... разместив код ниже. Спасибо BigBen за помощь.

Sub range1()
Dim i, a, lrow, lcol As Long
Dim rng As range

lrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lrow
    lcol = Cells(i, Columns.Count).End(xlToLeft).Column
    Cells(i, "a") = Cells(i, lcol).Value
Next i
End Sub