Доброе утро дамы и господа Есть 2 листа "1" и "3" - они частично заполнены данными. В столбце B листа "3" встречается буква "к". Надо эту букву и все символы следующие за ней до первого пробела скопировать на лист "3" в 10-ый столбец в соответствующую строку. Нумерация строк идет на листе "1" во 2-ом столбце, а на листе "3" в 1-ом столбце. Т.е. в J2 листа "1" копируем "К=4" из B27 листа "3". в J3 листа "1" копируем "Кн.1 Кзтр=0,8, Кэм=0,9" из B32 листа "3". в J4 листа "1" копируем "Кн.1 Кзтр=0,8, Кэм=0,9" из B37 листа "3". Спасибо. *** Очень похожа тема на эту "Если ячейкаA листа1=ячейкеB листа2, то скопировать ячейкуC", но копируем не ячейку целиком, а частично текст, в случае его обнаружения.
Доброе утро дамы и господа Есть 2 листа "1" и "3" - они частично заполнены данными. В столбце B листа "3" встречается буква "к". Надо эту букву и все символы следующие за ней до первого пробела скопировать на лист "3" в 10-ый столбец в соответствующую строку. Нумерация строк идет на листе "1" во 2-ом столбце, а на листе "3" в 1-ом столбце. Т.е. в J2 листа "1" копируем "К=4" из B27 листа "3". в J3 листа "1" копируем "Кн.1 Кзтр=0,8, Кэм=0,9" из B32 листа "3". в J4 листа "1" копируем "Кн.1 Кзтр=0,8, Кэм=0,9" из B37 листа "3". Спасибо. *** Очень похожа тема на эту "Если ячейкаA листа1=ячейкеB листа2, то скопировать ячейкуC", но копируем не ячейку целиком, а частично текст, в случае его обнаружения.Yar4i
Yar4i, привет можно попробовать вот такую польз. ф-цию [vba]
Код
Option Explicit Option Compare Text
Function WithK(sVal As String, rng As Range) As String Dim x, i&, j&, sp, s x = rng.Value
For i = 1 To UBound(x) If x(i, 1) = sVal Then sp = Split(x(i, 2), "К") For j = 1 To UBound(sp) s = s & " К" & Split(sp(j))(0) Next j Exit For End If Next i If Len(s) > 1 Then WithK = Mid(s, 2) End Function
[/vba] например, в яч. J2 листа 1 будет формула:
Код
=WithK(B2;'3'!$A$27:$B$82)
Yar4i, привет можно попробовать вот такую польз. ф-цию [vba]
Код
Option Explicit Option Compare Text
Function WithK(sVal As String, rng As Range) As String Dim x, i&, j&, sp, s x = rng.Value
For i = 1 To UBound(x) If x(i, 1) = sVal Then sp = Split(x(i, 2), "К") For j = 1 To UBound(sp) s = s & " К" & Split(sp(j))(0) Next j Exit For End If Next i If Len(s) > 1 Then WithK = Mid(s, 2) End Function
1. Создал новый модуль и вставил ваш код. 2. Открыл свой код и вставил: [vba]
Код
'для всех CD функция WithK МВТ, Manyasha For Each cell In Range("C1:D" & Cells(Rows.Count, "D").End(xlUp).Row) cell.Value = WithK(cell.Value) Next cell
[/vba] Аналогичный запуск функции с другим названием в большом коде макроса уже есть, мож из-за этого не работает
1. Создал новый модуль и вставил ваш код. 2. Открыл свой код и вставил: [vba]
Код
'для всех CD функция WithK МВТ, Manyasha For Each cell In Range("C1:D" & Cells(Rows.Count, "D").End(xlUp).Row) cell.Value = WithK(cell.Value) Next cell
[/vba] Аналогичный запуск функции с другим названием в большом коде макроса уже есть, мож из-за этого не работаетYar4i
Я ссылку на функцию один раз добавлял в тело макроса и по аналогии этого одного раза сделал и запуск данной функции WithK. Система выделяет жёлтым цветом название макроса "Макрос1" и синим фоном выделяет наименование функции "WithK", явно намекая на какую-то ошибку
Я ссылку на функцию один раз добавлял в тело макроса и по аналогии этого одного раза сделал и запуск данной функции WithK. Система выделяет жёлтым цветом название макроса "Макрос1" и синим фоном выделяет наименование функции "WithK", явно намекая на какую-то ошибкуYar4i