Имя: Пароль:
IT
 
Вопрос по Макросу Excel
0 Оберон
 
21.12.17
11:33
Добрый день.
Возникла необходимость перенумерации строк с текстом в эксель из выделенного диапазона.
Пример:
"1. Вася"
"3. Василий"
"4 Мася"
"  5. Виктория"
ну и т.д.
помогите написать
1 Оберон
 
21.12.17
11:36
пока что тлько формула есть
=ПРАВСИМВ(A1;(ДЛСТР(A1)-ПОИСК(".";A1)-1))
2 Tatitutu
 
21.12.17
11:39
Все намного проще

выделяешь нужный диапозон в EXCEL
данные - "текст по столбцам" - с разделителем - точка
готово
вместо
1. Вася
3. Василий
4. Мася
5. Виктория

у тебя будет ДВЕ КОЛОНКИ

1 | Вася
3 | Василий
4 | Мася
5 | Виктория
3 Tatitutu
 
21.12.17
11:40
и да - МАКРОС - это совершенно другая история )))
4 Оберон
 
21.12.17
11:44
(3) не подойдет, в строке может быть
"1. Иванов И.А."  или   "1 Иванов ИА."
5 Оберон
 
21.12.17
11:45
(3) и нужно не куда не переносить а тут же в той же ячейке сделать (((   только макрос пойдет.
6 Tatitutu
 
21.12.17
11:48
Возникла необходимость перенумерации строк с текстом в эксель из выделенного диапазона.

ответ в (2)
дальше
сортируешь , перенумеровываешь так ка нужно
в третьем столбце
пишешь формулу
=СЦЕПИТЬ(I14;".";J14)
и получишь результат
"1. Иванов И.А."

(5) ты ПУТАЕШЬ формулу и МАКРОС - это совершенно разные вещи
7 Оберон
 
21.12.17
11:53
(6) нет только макрос - основное из требований чтоб по при выделении диапазона в колонке и нажатию кнопки текст обработался и заменился - БЕЗ всяких сцепить и сделать в отдельном месте а потом обратно скопировать. Формулу привел именно для пониманию того как сделать через формулы. а НУЖНО МАКРОС
8 Tatitutu
 
21.12.17
12:41
Sub ЗаменаИНумерация()
Dim i As Long
Dim znach As Variant
Dim ttt As String

Dim diapazon As Range

Set diapazon = Application.Intersect(Selection, ActiveSheet.UsedRange)

ttt = "."

If diapazon Is Nothing Then
  MsgBox "Сначала выдели диапазон ячеек!"
  Exit Sub
Else

znach = 1

   For i = 1 To diapazon.Count
    
    tochka = InStr(1, diapazon(i), ttt)
    
    zamena = Mid(diapazon(i), tochka + 1)
    
    diapazon(i) = Str(znach) & ttt & zamena
    
    znach = znach + 1
    
   Next
End If

End Sub
9 Оберон
 
21.12.17
13:05
(8) уже сам слепил...

Sub RenumSelectRange()
   On Error Resume Next
   If Err Then Exit Sub
   With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
   i = 0
   For Each rCell In Selection.Cells
        i = i + 1
        t = rCell.Value
        a1 = Len(t)
        a2 = InStr(1, t, ".", vbTextCompare)
        a3 = Right(t, a1 - a2)
        rCell.Formula = i & ". " & a3
   Next rCell
   With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: End With
End Sub
10 Tatitutu
 
21.12.17
13:16
Спасибо за спасибо !

вот  с этим .Calculation = xlManual поаккуратнее
и вот это  rCell.Formula = i & ". " & a3  может не всегда "взлетать"
11 Neg
 
21.12.17
13:24
вот здесь по экселю хорошо помогают:
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=list&FID=1
Я не хочу быть самым богатым человеком на кладбище. Засыпать с чувством, что за день я сделал какую-нибудь потрясающую вещь — вот что меня интересует. Стив Джобс