Как отбросить лишнее в ячейках и разбить столбец на несколько / Microsoft Office

ReSQL.ru

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

Гость

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

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

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

Цитировать

Написать

Автор*:

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

Тема*:

Сообщение

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

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

Автор:

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

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

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

Вложение:

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

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

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

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

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

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Как отбросить лишнее в ячейках и разбить столбец на несколько

25 сообщений из 29, страница 1 из 2

все

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204068

elik13th

Гость

Спецы по скриптам, подскажите как в Excel'е реализовать следующую вещь 3мя разными или один скриптом. Или хотя бы подскажите, где копать. Времени почти нет... буквально, один рабочий день.

Дан стобец, в ячейках которого через запятую располагаются целые числа:

Код: plaintext

1.
2.
3.

| 12,3,55,7,700 |
| 51            |
| 13,23         |
| 45,5,97,6     |

Из него должно получиться 3 столбца:

Код: plaintext

1.
2.
3.

| x:/12.y | x:/3.y  | x:/55.y |
| x:/51.y |         |         |
| x:/13.y | x:/23.y |         |
| x:/45.y | x:/5.y  | x:/97.y |

Получается, что задача состоит из 3 частей. В какой последовательности их лучше решать - не знаю:
1. Нужно сократить количество чисел в каждой ячейке столбца до трёх, просто отбросив лишние справа:

Код: plaintext

1.
2.
3.

12,3,55
51
13,23
45,5,97

2. Добавить перед каждым числом 'x:/' и после каждого числа '.y':

Код: plaintext

1.
2.
3.

x:/12.y,x:/3.y,x:/55.y
x:/51.y
x:/13.y,x:/23.y
x:/45.y,x:/5.y,x:/97.y

3. Создать рядом ещё 2 столбца и распределить получившиеся конструкции по трём столбцам (разделитель - запятая):

Код: plaintext

1.
2.
3.

| x:/12.y | x:/3.y  | x:/55.y |
| x:/51.y |         |         |
| x:/13.y | x:/23.y |         |
| x:/45.y | x:/5.y  | x:/97.y |

...

Рейтинг:

0 / 0

18.09.2009, 13:43

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204095

elik13th

Гость

3я задача решена. Оказывается, всё просто.

меню "данные"-> "текст по столбцам..."
http://sql.ru/forum/actualthread.aspx?tid=299967&hl=%f0%e0%e7%e1%e8%f2%fc

...

Рейтинг:

0 / 0

18.09.2009, 13:51

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204181

elik13th

Гость

elik13th
2. Добавить перед каждым числом 'x:/' и после каждого числа '.y':

Код: plaintext

1.
2.
3.

x:/12.y,x:/3.y,x:/55.y
x:/51.y
x:/13.y,x:/23.y
x:/45.y,x:/5.y,x:/97.y

это решается функцией СЦЕПИТЬ()
http://office.microsoft.com/ru-ru/excel/HP052090201049.aspx

Как только всё это запихнуть в один скрипт...

...

Рейтинг:

0 / 0

18.09.2009, 14:14

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204355

MaximuS_G

Участник

Сообщения: 1 178

Рейтинг: 0 / 0

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.

Sub MozhetBitTak()
Dim MyArr
Dim tmpArr() As Integer
Dim MyString As String
Dim i As Byte, j As Byte, Counter As Byte

MyArr = Range("K6:K9") ' здесь указывать диапазон
ReDim MyArrT( 1  To UBound(MyArr,  1 ) +  1 ,  1  To  3 )

For i =  1  To UBound(MyArr,  1 )
    Counter = Len(MyArr(i,  1 )) - Len(Replace(MyArr(i,  1 ), ",", ""))
    Select Case Counter
    Case Is =  0 
    Cells(i,  1 ).Value = "x:=" & CStr(MyArr(i,  1 )) & ".y"
    Case Is =  1 
    Call getEl(MyArr(i,  1 ), tmpArr(),  2 )
    Cells(i,  1 ).Value = "x:=" & CStr(tmpArr( 1 )) & ".y"
    Cells(i,  2 ).Value = "x:=" & CStr(tmpArr( 2 )) & ".y"
    Case Is >=  2 
    Call getEl(MyArr(i,  1 ), tmpArr(),  3 )
    Cells(i,  1 ).Value = "x:=" & CStr(tmpArr( 1 )) & ".y"
    Cells(i,  2 ).Value = "x:=" & CStr(tmpArr( 2 )) & ".y"
    Cells(i,  3 ).Value = "x:=" & CStr(tmpArr( 3 )) & ".y"
    End Select
Next i

End Sub

Sub getEl(ByVal setElement As String, arr() As Integer, i As Byte)
Dim x As Byte, j As Byte

    For i =  1  To i
        x = x +  1 
        ReDim Preserve arr( 1  To x)
        arr(x) = CInt(Mid(setElement,  1 , InStr(setElement, ",") -  1 ))
        setElement = Mid(setElement, InStr(setElement, ",") +  1 )
        If Len(setElement) - Len(Replace(setElement, ",", "")) =  0  Then
        ReDim Preserve arr( 1  To x +  1 )
        arr(x +  1 ) = setElement
        Exit For
        End If
    Next i
        
End Sub

...

Рейтинг:

0 / 0

18.09.2009, 15:03

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204370

Hugo121

Гость

ReDim MyArr T (1 To UBound(MyArr, 1) + 1, 1 To 3)
T лишнее

...

Рейтинг:

0 / 0

18.09.2009, 15:06

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204429

Hugo121

Гость

Извиняюсь, стал изучать - T не лишнее (я думал - техническая описка...) почему так?

...

Рейтинг:

0 / 0

18.09.2009, 15:21

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204469

Hugo121

Гость

Автор, а нужна ли вообще эта строка? Без Т не работает, но работает без этой строки вообще...

...

Рейтинг:

0 / 0

18.09.2009, 15:33

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204476

elik13th

Гость

Hugo121 ,
Огроменное тебе спасибо! Выручил меня, полного нуля в VB.
Всё работает как надо!

...

Рейтинг:

0 / 0

18.09.2009, 15:35

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204489

elik13th

Гость

Hugo121Автор, а нужна ли вообще эта строка? Без Т не работает, но работает без этой строки вообще...
Я не знаю, времени с кодом разбираться нет совсем. Главное, что работает=)

...

Рейтинг:

0 / 0

18.09.2009, 15:37

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204504

MaximuS_G

Участник

Сообщения: 1 178

Рейтинг: 0 / 0

2 Hugo121 ,
Да Вы действительно правы, строка

Код: plaintext

ReDim MyArrT( 1  To UBound(MyArr,  1 ) +  1 ,  1  To  3 )

не нужна... Просто я сначала хотел все записать в массив, а потом в ячейки, но потом передумал... Забыл удалить строку :)

2 elik13th ,
Обидно, что топик стартеры зачастую не удосуживаются даже разобратся в коде...
А Вы даже не удосужились прочитать кто автор кода...

...

Рейтинг:

0 / 0

18.09.2009, 15:40

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36204529

elik13th

Гость

MaximuS_G,

Извини, пожалуйста! Конечно, недосмотрел.. виноват. Спасибо тебе, конечно, за код!!
Просто бегаю меж двух компов, стол завален схемами баз данных, туча окон открыто - нужно очень многое сегодня сделать. Самому интересно разобраться и всё автоматизировать к чертям, но реально сейчас нет времени. Ещё раз огромное спасибо!

...

Рейтинг:

0 / 0

18.09.2009, 15:46

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36205825

Hugo121

Гость

Ну раз меня посчитали автором кода, я просто обязан :)

Чисто из спортивного интереса (обрабатываем 1-ый столбец 1-го листа):

Код: plaintext

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

Sub TakKoroche()
Dim a
Dim x As Integer
Dim cc As Range

For Each cc In Application.Intersect(Worksheets( 1 ).Range("A:A"), Worksheets( 1 ).UsedRange)
a = Split(cc.Value, ",")
    For x =  0  To UBound(a)
    Cells(cc.Rows.Row, x +  1 ).Value = "x:=" & Trim(a(x)) & ".y"
    If x =  2  Then Exit For
    Next
Next

End Sub

...

Рейтинг:

0 / 0

19.09.2009, 19:47

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36206628

Deggasad

Участник

Откуда: Воронеж

Сообщения: 3 509

Рейтинг: 0 / 0

Решил поучаствовать:
1) вместо selection любой диапазон, в первом столбце которого данные для раздела
2) предполагается что конструкция x:/12.y нужна лишь визуально, при этом в ячейке остается лишь цифра, а меняется формат отображения, если не угадал то можно будет переделать это т момент
3) все данные более 3-х столбцов справа от первоначального столбцп очищаются.

Код: plaintext

1.
2.
3.
4.
5.
6.

Sub Макрос1()
 With Selection.Columns( 1 )
    .TextToColumns Destination:=IIf(.Cells( 1 ,  1 ) = "", .Cells( 1 ,  1 ).End(xlDown), .Cells( 1 ,  1 )), Comma:=True, Other:=True, OtherChar:="."
    .Resize(,  3 ).NumberFormat = """x:/""0"".y"""
    .Offset(,  3 ).Resize(, Columns.Count - .Column -  2 ).ClearContents
 End With
End Sub

...

Рейтинг:

0 / 0

21.09.2009, 00:02

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36209628

elik13th

Гость

DeggasadРешил поучаствовать:
2) предполагается что конструкция x:/12.y нужна лишь визуально, при этом в ячейке остается лишь цифра, а меняется формат отображения, если не угадал то можно будет переделать это т момент

не угадал =) Содержание - самое главное в данном случае.

Hugo121,
Скрипт работает на ура - именно его взял на вооружение. Т.к. мне в реальности не 3, а 8 столбов нужно, и в нём это легко правится. Спасибо!

...

Рейтинг:

0 / 0

22.09.2009, 11:58

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36209935

MaximuS_G

Участник

Сообщения: 1 178

Рейтинг: 0 / 0

2 Hugo121 ,
а можно вот эту строку словами ?

Код: plaintext

Application.Intersect(Worksheets( 1 ).Range("A:A"), Worksheets( 1 ).UsedRange)

Спасибо!

2 Deggasad ,
если не тяжело, можно вашу процедуру немного словами ?
Спасибо!

...

Рейтинг:

0 / 0

22.09.2009, 12:59

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36210267

Hugo121

Гость

MaximuS_G 2 Hugo121 ,
а можно вот эту строку словами ?

Код: plaintext

Application.Intersect(Worksheets( 1 ).Range("A:A"), Worksheets( 1 ).UsedRange)

- это сарказм?
Вероятно, просмотр столбца А первого листа, всей использованной области (всего листа, не только столбца А).
В детали не вдавался, взял из рабочего примера. Возможно, лучше заменить на что-то типа

Код: plaintext

Columns( 1 ).UsedRange

, но такой синтаксис не проходит...

elik13th - мне тоже мой код больше нравится, легко поменять все условия, кстати Trim() отрезает пробелы в начале и конце значений (на всякий случай, можно убрать, если не критично) :) - я пытался разобраться в коде MaximuS_G, но времени не хватило... но зато повёлся на его = и забыл про условие задачи (/) :)

...

Рейтинг:

0 / 0

22.09.2009, 14:18

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36210695

Deggasad

Участник

Откуда: Воронеж

Сообщения: 3 509

Рейтинг: 0 / 0

elik13thDeggasadРешил поучаствовать:
2) предполагается что конструкция x:/12.y нужна лишь визуально, при этом в ячейке остается лишь цифра, а меняется формат отображения, если не угадал то можно будет переделать это т момент

не угадал =) Содержание - самое главное в данном случае.

Я же написал, это можно переделать, основная суть моего участия, я хотел сделать без цикла, по крайней мере без цикла в VBA, ниже вариант, в котором очень легко менять количество столбцов :) и он остается без цикла.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.

Sub test()
 ЧслСтлб =  3 
 With Selection.Columns( 1 )
    .TextToColumns Destination:=IIf(.Cells( 1 ,  1 ) = "", .Cells( 1 ,  1 ).End(xlDown), .Cells( 1 ,  1 )), Comma:=True, Other:=True, OtherChar:="."
    .Resize(, ЧслСтлб).Value = Evaluate("If(" & .Resize(, ЧслСтлб).Address(, , , True) & "="""","""",""x:/""&" & .Resize(, ЧслСтлб).Address(, , , True) & "&"".y"")")
    .Offset(, ЧслСтлб).Resize(, Columns.Count - .Column - ЧслСтлб +  1 ).ClearContents
 End With
End Sub

...

Рейтинг:

0 / 0

22.09.2009, 16:02

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36211458

MaximuS_G

Участник

Сообщения: 1 178

Рейтинг: 0 / 0

Hugo121...- это сарказм?
Почему сарказм ? Просто функция intersect для меня немного неясна я и спросил...
Насколько я понимаю здесь:

Код: plaintext

Intersect(Worksheets( 1 ).Range("A:A"), Worksheets( 1 ).UsedRange)

будет проходится по каждой ячейке которая лежит на пересечении столбца А и UsedRange, тоесть только по столбцу А, так ? (проверил, вроде бы да)
Тогда действительно функция intersect лишняя... Лушче так:

Код: plaintext

For Each cc In Range("здесь диапазон")

2 Deggasad ,
Вы наверное тоже подумали что мой вопрос это сарказм ? На самом деле просто интересное решение...
Прийдется самому разбиратся

...

Рейтинг:

0 / 0

22.09.2009, 21:20

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36211493

Hugo121

Гость

Я старался подключить UsedRange, к сожалению без Intersect не получилось. А прописывать в код прямое указание на область не хочется, к тому же она нам не известна...
Хотя конечно так было бы красивее

Код: plaintext

For Each cc In Range("A1:A10")

...

Рейтинг:

0 / 0

22.09.2009, 22:00

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36211508

Hugo121

Гость

Ну разве что так (привлечь ActiveSheet.UsedRange):

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.

Sub test()
With ActiveSheet.UsedRange
For Each cc In Range("A:A")

MsgBox cc

If cc.Row = .Rows.Count Then Exit For
Next
End With
End Sub

...

Рейтинг:

0 / 0

22.09.2009, 22:18

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36212635

Deggasad

Участник

Откуда: Воронеж

Сообщения: 3 509

Рейтинг: 0 / 0

[quot Hugo121]Я старался подключить UsedRange, к сожалению без Intersect не получилось./quot]

а так ?

Код: plaintext

Worksheets( 1 ).UsedRange.Columns( 1 )

только
если Вы диапазон прямо не хотите указывать, то и Лист прямо незачем указывать.
И незачем в коде предполагать, что всегда x начинается с 1 , т.к. UsedRange не всегда начинается с 1-го столбца.

...

Рейтинг:

0 / 0

23.09.2009, 14:26

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36212800

Hugo121

Гость

Так

Код: plaintext

For Each cc In Worksheets( 1 ).UsedRange.Columns( 1 )

не проходит... зато работает так:

Код: plaintext

For Each cc In Worksheets( 1 ).UsedRange.Columns( 1 ).Cells

Спасибо!

Насчёт х - это не ко мне, мой х всегда начинается с 0 :)

Итого:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.

Sub TakKorocheUpdated()
For Each cc In ActiveSheet.UsedRange.Columns( 1 ).Cells
a = Split(cc.Value, ",")
    For x =  0  To UBound(a)
    Cells(cc.Rows.Row, x +  1 ).Value = "x:/" & Trim(a(x)) & ".y"
    If x =  2  Then Exit For
    Next
Next
End Sub

...

Рейтинг:

0 / 0

23.09.2009, 15:22

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36213358

Deggasad

Участник

Откуда: Воронеж

Сообщения: 3 509

Рейтинг: 0 / 0

Hugo121
Насчёт х - это не ко мне, мой х всегда начинается с 0 :)

Итого:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.

Sub TakKorocheUpdated()
For Each cc In ActiveSheet.UsedRange.Columns( 1 ).Cells
a = Split(cc.Value, ",")
    For x =  0  To UBound(a)
    Cells(cc.Rows.Row, x +  1 ).Value = "x:/" & Trim(a(x)) & ".y"
    If x =  2  Then Exit For
    Next
Next
End Sub

В том то и дело, ведь первый столбец в UsedRange не всегда A , а что будет если
первый столбец в UsedRange будет N ?
И в этом cc.Rows.Row явно переборщили, можно просто cc.Row

Предлагаю:
1) привязываться к имеющейся ячейке, коллекцию которых мы перебираем, это всегда более правильно, тогда можно оставить Ваш x :)

Код: plaintext

cc.offset(, x).Value = "x:/" & Trim(a(x)) & ".y"

2) Если все же оставлять имеющуюся конструкцию, то тогда так:

Код: plaintext

    Cells(cc.Row, x + cc.Column).Value = "x:/" & Trim(a(x)) & ".y"

но правильнее всегда к объекту привязаться, ведь он уже есть, то бишь вариант 1.

...

Рейтинг:

0 / 0

23.09.2009, 18:18

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36213402

Hugo121

Гость

Согласен, про х я не понял/запутался :)
А Rows.Row - где-то именно так работало, по привычке...
Но тогда и ActiveSheet.UsedRange.Columns(1).Cells надо как-то под активную ячейку переделать. У меня красиво не получается :( Или c = InputBox("Input Column Number", "c", "", 1500, 2000) привлечь.
Жаль только, что заказчику такой красивый код уже не нужен :)

...

Рейтинг:

0 / 0

23.09.2009, 18:40

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

Как отбросить лишнее в ячейках и разбить столбец на несколько

#36213592

Hugo121

Гость

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.

Sub TakKorocheUpdated2()
c = (InputBox("Input Column Number", "c", "1",  1500 ,  2000 )) *  1 
For Each cc In ActiveSheet.UsedRange.Columns(c).Cells
a = Split(cc.Value, ",")
    For x =  0  To UBound(a)
    Cells(cc.Row, x + cc.Column).Value = "x:/" & Trim(a(x)) & ".y"
    If x =  2  Then Exit For
    Next
Next
End Sub

...

Рейтинг:

0 / 0

23.09.2009, 20:50

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

25 сообщений из 29, страница 1 из 2

все

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

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

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

start [/forum/topic.php?fid=61&fpage=184&tid=2179022]:	0ms
get settings:	8ms
get forum list:	17ms
check forum access:	3ms
check topic access:	3ms
track hit:	20ms
get topic data:	9ms
get forum data:	2ms
get page messages:	63ms
get tp. blocked users:	1ms
others:	214ms

total:	340ms

	Необходимые cookie
	Cookie для сбора статистики
	Cookie для маркетинга и рекламы