| Вопрос: "Опять 25" ПРАЙС! | Добавлено: 15.11.06 09:28 |
Автор вопроса:  Василий
|
|
Таблица excel.
Проблема какой-то "умник" записал ГОСТы в одну ячейку через ALT+ENTER. ТОРМОЗНЫЕ КОЛОДКИ | 5880891 | 5881040 | 5881214 __________________| 5888144 ТОРМОЗНОЙ ЦИЛИНДР | 44303801 | 44307501 __________________| 44305501 А надо привести к стандарту баз данных ТОРМОЗНЫЕ КОЛОДКИ | 5880891 ТОРМОЗНЫЕ КОЛОДКИ | 5881040 Таких записей 900!!! Вручную переделывать грусная картина. Помогите с макросом. В редакторе комбинация ALT+ENTER пишется функцией Chr(10) ActiveCell.FormulaR1C1 = "1321" & Chr(10) & "3213" & Chr(10) & "3214"
но как извлечь я не знаю. Подскажите на примере одной строки цикл для всех я сделаю сам. |
| Ответы | Всего ответов: 3 |
|
Номер ответа: 1 Автор ответа: Василий Вопросов: 8 Ответов: 27 |
Профиль | | #1 | Добавлено: 19.11.06 19:25 |
|
Сам сделал.
Может кому пригодится. Зарание спасибо всем кто упростит. Sub aRazborka()
Dim MyText, SearchChar, MyPos, MyPos2, MyPos3 Application.ScreenUpdating = False 'отменить обновление экрана Do Do On Error Resume Next MyText = ActiveCell ' Обрабатываемая ячейка SearchChar = Chr(10) ' Символ комбинации ALT+ENTER MyPos = Left(MyText, Len(MyText) - (Len(MyText) - (InStr(MyText, Chr(10)) - 1))) ' Первая группа цифр MyPos2 = Mid(MyText, InStr(MyText, Chr(10)) + 1, Len(MyText) - (InStr(MyText, Chr(10)))) ' Без первой группы MyPos3 = InStr(MyText, Chr(10)) ActiveCell.Offset(1, 0).Range("A1"  .Select ' На строку вниз
Selection.EntireRow.Insert ' Вставка строки ActiveCell.Offset(-1, 0).Range("A1" .Select ' На строку вверх
Range(Selection, Selection.End(xlToRight)).Select ' Выделяет все значения в право Application.CutCopyMode = False 'Копирует Selection.Copy ActiveCell.Offset(1, 0).Range("A1" .Select ' На строку вниз
ActiveSheet.Paste ' Всавляет ActiveCell.Offset(-1, 0).Range("A1" .Select ' На строку вверх
ActiveCell = MyPos ' Вставка первой группы цифр Selection.NumberFormat = "0" 'Форматирование ActiveCell.Offset(1, 0).Range("A1" .Select ' На строку вниз
ActiveCell = MyPos2 ' Вставка без первой группы цифр Loop While MyPos3 <> 0 ' Закончить цикл если ..."правильно =0" но ????? Может кто поправит. ActiveCell.Offset(1, 0).Range("A1" .Select ' На строку вниз
Loop While ActiveCell <> "" ' Закончить цикл если пустая ячейка Application.ScreenUpdating = True 'разрешить обновление экрана End Sub |
||
|
Номер ответа: 2 Автор ответа:  GenyaA Вопросов: 0 Ответов: 185 |
Web-сайт: Профиль | | #2 | Добавлено: 19.11.06 19:54 |
|
Sub aRazborka()
Dim cc As Range Dim i As Long, j As Long, Col As Integer Col = 2 With ActiveSheet For i = .UsedRange.Rows.Count To 1 Step -1 Set cc = .Cells(i, Col) dd = Split(cc.Value, Chr(10)) If UBound(dd) > 0 Then For j = UBound(dd) To 1 Step -1 cc.Offset(1, 0).EntireRow.Insert cc.EntireRow.Copy Destination:=cc.Offset(1, 0).EntireRow cc.Offset(1, 0) = dd(j) Next j cc = dd(0) End If Next i End With End Sub |
||
|
Номер ответа: 3 Автор ответа: ВасилийВопросов: 8 Ответов: 27 |
Профиль | | #3 | Добавлено: 19.11.06 21:35 |
|
Спасибо GenyaA я не много подправил. Обьявил переменную dd
Sub aRazborka_1()
Dim cc As Range Dim i As Long, j As Long, Col As Integer, dd Col = 2 With ActiveSheet For i = .UsedRange.Rows.Count To 1 Step -1 Set cc = .Cells(i, Col) dd = Split(cc.Value, Chr(10)) If UBound(dd) > 0 Then For j = UBound(dd) To 1 Step -1 cc.Offset(1, 0).EntireRow.Insert cc.EntireRow.Copy Destination:=cc.Offset(1, 0).EntireRow cc.Offset(1, 0) = dd(j) Next j cc = dd(0) End If |
||
Страница: 1 |