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

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

Спасибо!
...
Рейтинг: 0 / 0
22.08.2013, 00:16
    #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
22.08.2013, 15:12
    #38374788
lapochka2382
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
копирование ячеек
lbppb,
огромнейшее спасибо!!!
это то, что нужно!!!

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


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