powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / копирование ячеек
3 сообщений из 3, страница 1 из 1
копирование ячеек
    #38373781
lapochka2382
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Добрый вечер!
Подскажите, пожалуйста, каким образом в vba можно описать следующее условие:

если ячейка A1 не пустая, то в ячейку B1 записывается формула сцепления: "PR" & данные ячейки A1
и чтобы эта проверка выполнялась до конца листа.

Спасибо!
...
Рейтинг: 0 / 0
копирование ячеек
    #38374001
Фотография lbppb
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
lapochka2382,

Правда не понятно для чего именно формулу вставлять, но хозяин-барин.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
Option Explicit

Public Sub CheckAndConcatenate()

Dim t
Dim sh As Worksheet
Dim rngCheck As Range
Dim strColumn1 As String
Dim strColumn2 As String
Dim strConcat As String
Dim cell As Range

t = Timer

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Set sh = ActiveSheet
strColumn1 = "A"
strColumn2 = "B"
strConcat = "PR"
Set rngCheck = sh.Range(strColumn1 & "1:" & strColumn1 & LastCellOfColumn(sh, strColumn1))

For Each cell In rngCheck
    If LenB(cell.Value2) > 0 Then
        sh.Range(strColumn2 & cell.Row).Formula = "=""" & strConcat & """&" & cell.Address
        'sh.Range(strColumn2 & cell.Row).Value2 = strConcat & cell.Value2 'However, I think this is the way better rather than to use formula.
    End If
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

Debug.Print Timer - t

End Sub

Private Function LastCellOfColumn(Sheet As Worksheet, Column As String) As Long

Dim rng As Range

Set rng = Sheet.Range(Column & Sheet.Rows.Count)
If LenB(rng.Value2) > 0 Then
    LastCellOfColumn = rng.Row
Else
    LastCellOfColumn = rng.End(xlUp).Row
End If

End Function
...
Рейтинг: 0 / 0
копирование ячеек
    #38374788
lapochka2382
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
lbppb,
огромнейшее спасибо!!!
это то, что нужно!!!

и вариант без формулы в ячейке мне тоже понравился больше))
...
Рейтинг: 0 / 0
3 сообщений из 3, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / копирование ячеек
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]