поиск и перенос текста / Visual Basic

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / поиск и перенос текста

7 сообщений из 7, страница 1 из 1

поиск и перенос текста

#37203867

DOXmeister

Гость

(Сам нюб в этом деле, не понимаю совсем)

Ребят помогите пожалуйста. Есть код, поиск и перенос определенных символов, но он ищет до пустой ячейки, подскажите как сделать, что бы искал до конца (до первого совпадения). За ранее спасибо.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.

Private Sub CommandButton1_Click()
Range("B9").Select
do until isempty(activecell)
input_text = ActiveCell.Text
Length = Len(input_text)
first_position = InStr(input_text, "TL")
If first_position =  0  Or first_position = Length -  2  +  1  Then
Exit Sub
End If
ActiveCell.Formula = Left(input_text, first_position -  1 ) + Right(input_text, Length - first_position + 1  -  2 ) + "TL"
activecell.offset( 1 ,  0 ).select
loop

End Sub

...

Рейтинг:

0 / 0

07.04.2011, 08:55

| Ответить | Цитировать | Написать

поиск и перенос текста

#37203927

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

DOXmeisterчто бы искал до конца (до первого совпадения)

так до конца или до первого совпадения, уж определись

Код: plaintext

do until isempty(activecell)

эта строка отвечает за поиск до первой пустой ячейки. Можно превратить ее просто в

Код: plaintext

Do

Код: plaintext

1.
2.

If first_position =  0  Or first_position = Length -  2  +  1  Then
  Exit Sub
End If

этот фрагмент отвечает за поиск до тех пор, пока не найдет ячейку где нет "TL", либо "TL" стоит в самом конце строки.

...

Рейтинг:

0 / 0

07.04.2011, 09:50

| Ответить | Цитировать | Написать

поиск и перенос текста

#37204150

DOXmeister

Гость

Shocker.Pro,

Есть столбец, в котором допустим 1000 строк (195/60R15 TL BR 88V MY01 ...) (Но есть строки где нет "TL"), так вот данный цикл когда доходит до строк где нет TL, останавливается, а мне нужно что бы он дальше искал и переносил "TL"

...

Рейтинг:

0 / 0

07.04.2011, 11:13

| Ответить | Цитировать | Написать

поиск и перенос текста

#37204212

DOXmeister

Гость

Вот сам файл

...

Рейтинг:

0 / 0

07.04.2011, 11:34

| Ответить | Цитировать | Написать

поиск и перенос текста

#37204254

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.

Private Sub CommandButton1_Click()

Dim i as Integer
For i= 9  To  1000 
input_text = Cells(i, 2 ).Text
Length = Len(input_text)
first_position = InStr(input_text, "TL")
If Not (first_position =  0  Or first_position = Length -  2  +  1 ) Then
  Cells(i, 2 )ActiveCell.Formula = Left(input_text, first_position -  1 ) + Right(input_text, Length - _
    first_position + 1  -  2 ) + "TL"
End If
Next

End Sub

Ну тогда как-то так, проверять некогда сами доведите до ума, если ошибся

...

Рейтинг:

0 / 0

07.04.2011, 11:54

| Ответить | Цитировать | Написать

поиск и перенос текста

#37205260

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.

Private Sub CommandButton1_Click()

Dim i as Integer
For i= 9  To  1000 
input_text = Cells(i, 2 ).Text
Length = Len(input_text)
first_position = InStr(input_text, "TL")
If Not (first_position =  0  Or first_position = Length -  2  +  1 ) Then
  Cells(i, 2 ).Formula = Left(input_text, first_position -  1 ) + Right(input_text, Length - _
    first_position + 1  -  2 ) + "TL"
End If
Next

End Sub

Немножко освободился, проверил на приложенном файле - исправил опечатку.

Рекомендую также удалять двойные пробелы, которые получаются в результате вырезания "TL"

...

Рейтинг:

0 / 0

07.04.2011, 17:20

| Ответить | Цитировать | Написать

поиск и перенос текста

#37205837

DOXmeister

Гость

Shocker.Pro

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.

Private Sub CommandButton1_Click()

Dim i as Integer
For i= 9  To  1000 
input_text = Cells(i, 2 ).Text
Length = Len(input_text)
first_position = InStr(input_text, "TL")
If Not (first_position =  0  Or first_position = Length -  2  +  1 ) Then
  Cells(i, 2 ).Formula = Left(input_text, first_position -  1 ) + Right(input_text, Length - _
    first_position + 1  -  2 ) + "TL"
End If
Next

End Sub

Немножко освободился, проверил на приложенном файле - исправил опечатку.

Рекомендую также удалять двойные пробелы, которые получаются в результате вырезания "TL"

Спасибо большое, очень сильно помог !!!

...

Рейтинг:

0 / 0

08.04.2011, 00:42

| Ответить | Цитировать | Написать

7 сообщений из 7, страница 1 из 1

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / поиск и перенос текста

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=60&msg=37204212&tid=2158818]:	0ms
get settings:	9ms
get forum list:	12ms
check forum access:	4ms
check topic access:	4ms
track hit:	60ms
get topic data:	9ms
get forum data:	2ms
get page messages:	40ms
get tp. blocked users:	1ms
others:	240ms

total:	381ms