Форум программистов, компьютерный форум, киберфорум
MS Office Excel
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.69/16: Рейтинг темы: голосов - 16, средняя оценка - 4.69
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
1

Изменение части значения ячейки Excel

25.10.2019, 12:43. Просмотров 2898. Ответов 54

Добрый день, уважаемые коллеги!

Встала задача по рассылке почты по разным адресам с разным текстом, через VBA создал код:

Visual Basic
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
Sub Send_Mail_Mass()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
    Dim lr As Long, lLastR As Long
 
    Application.ScreenUpdating = False
    On Error Resume Next
 
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
 
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
    objOutlookApp.Session.Logon
 
    lLastR = Cells(Rows.Count, 1).End(xlUp).Row
 
    For lr = 2 To lLastR
        Set objMail = objOutlookApp.CreateItem(0)
 
        With objMail
            .to = Cells(lr, 1).Value
            .Subject = Cells(lr, 2).Value
            .Body = Cells(lr, 3).Value
            .Attachments.Add Cells(lr, 4).Value
            .Send
        End With
    Next lr
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
Все отлично отрабатывает и в зависимости от значения ячеек, на разные адреса отправляется разный текст и разная тема письмо, но задача усложнилась, и как её решить-я пока не разобрался, вследствии этого-прошу помощи по её решению.

Задача:
ячейка1-адрес почты
ячейка2-тема письма
ячейка3-текст письма + 1111
ячейка4-изменяемое значение от 1000 до 9999(значение меняется в ручную)

Так вот надо, что бы при изменении значения в ячейке4, изменялась часть значения в ячейке3, то есть сам текст не менялся, а менялись только цифры.
В итоге я не нашел информации по изменению именно части текста в ячейке, а не замена значения всей ячейки.

Заранее спасибо за уделенное время!
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
25.10.2019, 12:43
Ответы с готовыми решениями:

Задать значения ячейки excel, в зависимости от значения другой ячейки
Всем, доброго времени суток. Нужно помощь при работе в excel. Перечитал кучу форумов, кое-что на...

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

Формула для копирования части данных из одной ячейки в другую - MS Excel
Здравствуйте Прошу вас о помощи Есть строка, она может быть любой длины. Из нее требуется...

VBA Excel Изменение цвета ячейки
Есть ячейка G3 в которой выводится значение либо &quot;промах&quot; либо &quot;попадание&quot; в зависимости от...

54
307 / 215 / 80
Регистрация: 18.11.2015
Сообщений: 892
25.10.2019, 13:17 2
Конечно можно и так:

Visual Basic
1
.Body = left(Cells(lr, 3), len(Cells(lr, 3)-4) & Cells(lr, 4)
Но не проще до запуска макроса отправки почты менять значение в ячейке3?
1
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
25.10.2019, 14:20  [ТС] 3
Огромное спасибо, буду разбираться в коде.
На счет вашего вопроса, конечно думал об этом, и скорее всего так и буду делать, но дело в то, что значения меняются в другом файле, и мне было бы удобно просто каждый раз менять столбец в файле с кодом. Что бы в ручную в каждом тексте письма не менять это четырехзначное значение, беря его из другого файла.

Если вас не затруднит, могли бы расписать привязку вашего кода к ячейкам?

Добавлено через 14 минут
Не получается корректно доработать свой код используя ваше предложение

Добавлено через 21 минуту
Хотел бы добавить:
Можно использовать 2 макроса
1. замена части значения в ячейке 3 из данных в ячейке 4
2. выполнения макроса по отправке почты

Вот как раз проблема с частью 1(замена части значения в ячейке 3)
0
307 / 215 / 80
Регистрация: 18.11.2015
Сообщений: 892
25.10.2019, 14:32 4
Visual Basic
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
Sub Send_Mail_Mass()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Dim lr As Long, lLastR As Long
 
Application.ScreenUpdating = False
On Error Resume Next
 
Set objOutlookApp = GetObject(, "Outlook.Application")
Err.Clear
If objOutlookApp Is Nothing Then
Set objOutlookApp = CreateObject("Outlook.Application")
End If
 
If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
objOutlookApp.Session.Logon
 
lLastR = Cells(Rows.Count, 1).End(xlUp).Row
 
For lr = 2 To lLastR
Set objMail = objOutlookApp.CreateItem(0)
 
With objMail
.to = Cells(lr, 1).Value
.Subject = Cells(lr, 2).Value
.Body = Left(Cells(lr, 3), Len(Cells(lr, 3)) - 4) & Cells(lr, 4)
.Attachments.Add Cells(lr, 4).Value
.Send
End With
Next lr
 
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
Добавлено через 1 минуту
Visual Basic
1
2
3
4
5
6
7
8
Sub ЗаменаЯчейки3()
lLastR = Cells(Rows.Count, 1).End(xlUp).Row
 
For lr = 2 To lLastR
Cells(lr, 3) = Left(Cells(lr, 3), Len(Cells(lr, 3)) - 4) & Cells(lr, 4)
Next lr
 
End Sub
Добавлено через 1 минуту
Если решите применять сначала ЗаменаЯчейки3, то основной макрос оставьте свой либо только мою версию Вашего макроса Send_Mail_Mass
1
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
25.10.2019, 14:47  [ТС] 5
Огромное спасибо!

Буду разбираться, по итогу, отпишусь!

Добавлено через 6 минут
Что-то не работает корректно, видимо где то ошибся,

Необходимо чтоб код искал в ячейке 3(оно там одно) любое 4-х значное числовое значение от 0000 до 9999 и заменял это значение на значение указанное в ячейке 4.

Выполнил отдельно вашу команду, заменились последние два символа текста в ячейке 3, на данные в ячейке 4

Пример:
ячейка 3 - Привет, комната 5555, пока
ячейка 4 - 7833

После выполнения команды:

ячейка 3 - Привет, комната 7833, пока
0
307 / 215 / 80
Регистрация: 18.11.2015
Сообщений: 892
25.10.2019, 14:56 6
Это я взял на основе Вашего примера:
Цитата Сообщение от qpaHaT Посмотреть сообщение
ячейка3-текст письма + 1111
ячейка4-изменяемое значение от 1000 до 9999(значение меняется в ручную)
Там всегда буде четыре каких-то цифры?
1
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
25.10.2019, 15:21  [ТС] 7
Да, всегда число состоящее из 4х цифр.

Чтото типа шаблона текста в котором надо менять это значение, состоящее из 4х цифр.
Но это число из 4х цифр стоит всередине текста ячейки 3

Добавлено через 20 минут
Да, я не правильно выразился в задании.

Старые данные:

ячейка3-текст письма + 1111

Новые данные:

ячейка3-текст письма, текст письма + 1111 + текст письма.
0
307 / 215 / 80
Регистрация: 18.11.2015
Сообщений: 892
25.10.2019, 15:35 8
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub ЗаменаЯчейки3()
lLastR = Cells(Rows.Count, 1).End(xlUp).Row
 
For lr = 1 To lLastR
    For curS = 1 To Len(Cells(lr, 3))
        If IsNumeric(Mid(Cells(lr, 3), curS, 1)) Then
        Cells(lr, 3) = Replace(Cells(lr, 3), Mid(Cells(lr, 3), curS, 4), Cells(lr, 4))
        Exit For
        End If
    Next curS
 
Next lr
 
End Sub
Добавлено через 2 минуты
При условии что других цифр до заменяемого числа в тексте нет
1
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
25.10.2019, 15:39  [ТС] 9
ArtNord, почему то код с ошибкой
0
Миниатюры
Изменение части значения ячейки Excel  
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
25.10.2019, 15:46  [ТС] 10
Другие цифровые значению в тексте письма присутствуют, но 4х значных только одно.
Значит данный метод не сработает, правильно понимаю?
А может есть метод который просматривает текст в ячейке и найдя 4х значное числовое значение, меняет его на значение из ячейки 4?
0
307 / 215 / 80
Регистрация: 18.11.2015
Сообщений: 892
25.10.2019, 15:52 11
Попробуйте:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub ЗаменаЯчейки3()
lLastR = Cells(Rows.Count, 1).End(xlUp).Row
 
For lr = 1 To lLastR
    For curS = 1 To Len(Cells(lr, 3))
        If IsNumeric(Mid(Cells(lr, 3), curS, 1)) Then flag = flag + 1 Else flag = 0
        If flag = 4 Then Cells(lr, 3) = Replace(Cells(lr, 3), Mid(Cells(lr, 3), curS, 4), Cells(lr, 4)): Exit For
        End If
    Next curS
flag = 0
Next lr
 
End Sub
1
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
25.10.2019, 16:11  [ТС] 12
ArtNord, что то не так
0
Миниатюры
Изменение части значения ячейки Excel   Изменение части значения ячейки Excel  
307 / 215 / 80
Регистрация: 18.11.2015
Сообщений: 892
25.10.2019, 16:37 13
Извиняюсь, не протестил. Вот:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub ЗаменаЯчейки3()
lLastR = Cells(Rows.Count, 1).End(xlUp).Row
 
For lr = 1 To lLastR
    For curS = 1 To Len(Cells(lr, 3))
        If IsNumeric(Mid(Cells(lr, 3), curS, 1)) Then
        flag = flag + 1
        Repl = Repl & Mid(Cells(lr, 3), curS, 1)
        Else
        flag = 0
        Repl = ""
        End If
        If flag = 4 Then Cells(lr, 3) = Replace(Cells(lr, 3), Repl, Cells(lr, 4)): Exit For
    Next curS
flag = 0
Next lr
 
End Sub
1
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
25.10.2019, 16:41  [ТС] 14
Огооонь! Работает!

Огромное спасибо за проделанную работу!

П.С. а можно вас еще попытать?)
0
307 / 215 / 80
Регистрация: 18.11.2015
Сообщений: 892
25.10.2019, 16:43 15
Давайте
1
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
25.10.2019, 16:48  [ТС] 16
ArtNord,
Все, остальное сам доделал!

Огромное спасибо!!!

Все работает как часы!

П.С. куда высылать голду?))))
0
307 / 215 / 80
Регистрация: 18.11.2015
Сообщений: 892
25.10.2019, 16:49 17
Работаем за лайки)
1
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
29.10.2019, 10:07  [ТС] 18
ArtNord, а есть возможность все в один скрипт запилить, и замену ячейки 3 и отправку писем по адресам из ячейки 1?
0
307 / 215 / 80
Регистрация: 18.11.2015
Сообщений: 892
29.10.2019, 10:19 19
Да, выложите итоговые скрипты, которыми пользуетесь
0
0 / 0 / 0
Регистрация: 28.11.2016
Сообщений: 111
29.10.2019, 10:24  [ТС] 20
Visual Basic
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
52
53
Sub ЗаменаЯчейки3()
lLastR = Cells(Rows.Count, 1).End(xlUp).Row
 
For lr = 1 To lLastR
    For curS = 1 To Len(Cells(lr, 3))
        If IsNumeric(Mid(Cells(lr, 3), curS, 1)) Then
        flag = flag + 1
        Repl = Repl & Mid(Cells(lr, 3), curS, 1)
        Else
        flag = 0
        Repl = ""
        End If
        If flag = 4 Then Cells(lr, 3) = Replace(Cells(lr, 3), Repl, Cells(lr, 4)): Exit For
    Next curS
flag = 0
Next lr
 
End Sub
 
Sub Send_Mail_Mass()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Dim lr As Long, lLastR As Long
 
Application.ScreenUpdating = False
On Error Resume Next
 
Set objOutlookApp = GetObject(, "Outlook.Application")
Err.Clear
If objOutlookApp Is Nothing Then
Set objOutlookApp = CreateObject("Outlook.Application")
End If
 
If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
objOutlookApp.Session.Logon
 
lLastR = Cells(Rows.Count, 1).End(xlUp).Row
 
For lr = 2 To lLastR
Set objMail = objOutlookApp.CreateItem(0)
 
With objMail
.to = Cells(lr, 1).Value
.Subject = Cells(lr, 2).Value
.Body = Left(Cells(lr, 3), Len(Cells(lr, 3)) - 4) & Cells(lr, 4)
.Attachments.Add Cells(lr, 4).Value
.Send
End With
Next lr
 
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
29.10.2019, 10:24

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Изменение значения ячейки по щелчку
Добрый день. Подскажите код как увеличивать значение ячейки на 1 в таблице по 2му щелчку или по...

Как в столбце Excel найти совпадение по части текста и вывести ячейки где нет совпадений?
Нужно: - сравнить каждое значение из второго столбца с первым столбцом (т.е. сравнить два столбца...

Изменение цвета ячейки в таблице Excel в зависимости от сегодняшней даты
День добрый!! Подскажите пожалуйста, как настроить таблицу Эксель, что бы менялся цвет ячейки в...

Изменение значения ячейки через другую ячейку
Приветствую. Нужно сделать следующее: Ячейка А1 должна изменяться в зависимости от ячейки В1....

Задать значения ячейки excel
Доброго дня! подскажите пожалуйста, как в приложенном файле сделать возможность сортировки по коду...

Задать значения ячейки excel, в зависимости от другой
Всем привет,я чайник сразу скажу.Нужна помощь.Есть Вот такой вот журнал.Как задать значения...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.