Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / поиск и перенос текста / 7 сообщений из 7, страница 1 из 1
07.04.2011, 08:55
    #37203867
DOXmeister
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, 09:50
    #37203927
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск и перенос текста
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, 11:13
    #37204150
DOXmeister
DOXmeister
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск и перенос текста
Shocker.Pro,

Есть столбец, в котором допустим 1000 строк (195/60R15 TL BR 88V MY01 ...) (Но есть строки где нет "TL"), так вот данный цикл когда доходит до строк где нет TL, останавливается, а мне нужно что бы он дальше искал и переносил "TL"
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.04.2011, 11:34
    #37204212
DOXmeister
DOXmeister
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поиск и перенос текста
Вот сам файл
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.04.2011, 11:54
    #37204254
Shocker.Pro
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 )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, 17:20
    #37205260
Shocker.Pro
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
    #37205837
DOXmeister
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
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / поиск и перенос текста / 7 сообщений из 7, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 356ms
Закрыть
start [/forum/topic.php?fid=60&mobile=1&tid=2158818]:
 0ms
get settings:
 10ms
get forum list:
 14ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 37ms
get topic data:
 11ms
get forum data:
 3ms
get page messages:
 37ms
get tp. blocked users:
 1ms
others: 235ms
total:  356ms
x
x
Закрыть


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