Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - VBA

Страница: 1 |

 

  Вопрос: Текст по столбцам Добавлено: 25.04.10 21:49  

Автор вопроса:  tim2004
Друзья, подскажите код макроса. Нужно разнести текст по столбцам. В качестве разделителя- первое в строке сочетание пробела и любой буквы русского алфавита.

Ответить

  Ответы Всего ответов: 1  

Номер ответа: 1
Автор ответа:
 Jasmin



Вопросов: 23
Ответов: 417
  Профиль | | #1 Добавлено: 27.04.10 13:24
  1. Sub SplitSpaceLetter()
  2.   Dim i As Byte
  3.   Dim MyTempStr As String
  4.   Dim MyCol As Byte, MyPosCur As Byte, MyPosOld As Byte
  5.   
  6.   Range(Cells(2, 2), Cells(5, 10)).ClearContents
  7.   
  8.   For i = 2 To 5
  9.     MyTempStr = Range("A" & i).Value
  10.     MyCol = 2
  11.     MyPosCur = 1
  12.     MyPosOld = 1
  13.     
  14.     Do While MyPosCur <= Len(MyTempStr)
  15.       If Mid(MyTempStr, MyPosCur, 1) = " " Then
  16.         If UCase(Mid(MyTempStr, MyPosCur + 1, 1)) Like "[А-Я]" Then
  17.           'если нужно убрать пробелы, то
  18.           'Cells(i, MyCol).Value = Trim(Mid(MyTempStr, MyPosOld, MyPosCur - MyPosOld))
  19.           
  20.           Cells(i, MyCol).Value = Mid(MyTempStr, MyPosOld, MyPosCur - MyPosOld)
  21.           'если нужно только первое, то следующих 3 строки стереть
  22.           'если нужны все, то стереть только Exit Do
  23.           'Exit Do
  24.           MyCol = MyCol + 1
  25.           MyPosOld = MyPosCur + 1
  26.         End If
  27.       End If
  28.       MyPosCur = MyPosCur + 1
  29.     Loop
  30.     'если нужно убрать пробелы, то
  31.     'Cells(i, MyCol).Value = Trim(Mid(MyTempStr, MyPosOld, MyPosCur - MyPosOld))
  32.     
  33.     Cells(i, MyCol).Value = Mid(MyTempStr, MyPosOld, MyPosCur - MyPosOld)
  34.   Next i
  35. End Sub

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам