Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 23.11.2017, 11:59   #1
GoreProgrammist
Пользователь
 
Регистрация: 13.07.2009
Сообщений: 52
По умолчанию Форматирование таблицы (текст по столбцам)

Доброго дня.

Помогите пожалуйста написать макрос для форматирования таблицы вида:
1 столбец - "Дата записи"
2 столбец - Номера заказов разделённые "," (в одной ячейке несколько номеров заказов)

Отформатировать в таблицу на Лист2:

1 столбец - Номер заказа (один)
2 столбец - Соответствующая ему дата

Пробовал через "Тест по столбцам", но проблема в том что заказы разделяются на несколько столбцов (от 1 до 10), нужно их как то потом свести в один столбец с добавлением соответствующей даты в соседний столбец. Без VBA похоже тут не обойтись(( а я всё забыл, 2 часа потратил на поиск, похожего решения с циклом по ячейкам и не нашёл.
Запись ведётся вручную операторами, мне нужно отформатировать её таким образом что бы залить данные в базу, вместо того что бы руками проставлять у каждого заказа. Был бы рад любой помощи.
Вложения
Тип файла: xlsx Книга3.xlsx (11.2 Кб, 20 просмотров)
GoreProgrammist вне форума Ответить с цитированием
Старый 23.11.2017, 13:12   #2
ПаВлА
Пользователь
 
Регистрация: 20.11.2017
Сообщений: 16
По умолчанию

Код:
Sub zakaz()
Dim arr As Range, i&, y&, x&
Application.ScreenUpdating = 0
Set arr = Sheets(1).[A5].CurrentRegion.Offset(1)
ReDim t(1 To arr.Rows.Count * 5, 1 To 3)
    For i = 1 To arr.Rows.Count
        If UBound(Split(arr(i, 3), ",")) < 1 And Not IsEmpty(arr(i, 1)) Then
            x = x + 1
            t(x, 1) = Int(arr(i, 1))
            t(x, 2) = Format(arr(i, 1), "hh:ss")
            t(x, 3) = arr(i, 3)
        Else
            For y = 0 To UBound(Split(arr(i, 3), ","))
                x = x + 1
                t(x, 1) = Int(arr(i, 1))
                t(x, 2) = Format(arr(i, 1), "hh:ss")
                t(x, 3) = Split(arr(i, 3), ",")(y)
            Next
        End If
    Next
Sheets(2).[A1:C1] = [{"Дата","Время","Заказ"}]
Sheets(2).[A2].Resize(x, 3) = t
Application.ScreenUpdating = 1
End Sub

Последний раз редактировалось ПаВлА; 23.11.2017 в 15:09.
ПаВлА вне форума Ответить с цитированием
Старый 23.11.2017, 13:50   #3
GoreProgrammist
Пользователь
 
Регистрация: 13.07.2009
Сообщений: 52
По умолчанию

Цитата:
Сообщение от ПаВлА Посмотреть сообщение
Код:
Sub zakaz()
Dim arr As Range, i&, y&, x&
Application.ScreenUpdating = 0
Set arr = Sheets(1).UsedRange.Offset(2)
ReDim t(1 To arr.Rows.count * 5, 1 To 2)
    For i = 1 To arr.Rows.count
        If UBound(Split(arr(i, 3), ",")) < 1 And Not IsEmpty(arr(i, 1)) Then
            x = x + 1
            t(x, 2) = arr(i, 1)
            t(x, 1) = arr(i, 3)
        Else
            For y = 0 To UBound(Split(arr(i, 3), ","))
                x = x + 1
                t(x, 2) = arr(i, 1)
                t(x, 1) = Split(arr(i, 3), ",")(y)
            Next
        End If
    Next
Sheets(2).[A1].Resize(x, 2) = t
Application.ScreenUpdating = 1
End Sub
Большое пребольшое спасибо, работает!
Я только поменял местами порядок столбцов на листе с результатами.

А можно вас ещё попросить в порядке наглости, в коде "Дату записи" столбец B, разделить на 2 столбца - Время в столбце B и Дату в столбце C? Я так понимаю надо ещё раз Split сделать с разделителем " ".
Попробовал через запись макроса но почему то когда вставляю записанный код, перестаёт вообще выводить какой бы то ни было результат(
GoreProgrammist вне форума Ответить с цитированием
Старый 23.11.2017, 14:56   #4
GoreProgrammist
Пользователь
 
Регистрация: 13.07.2009
Сообщений: 52
По умолчанию

Код:
Sub zakaz()

Dim arr As Range, i&, y&, x&

Application.ScreenUpdating = 0
Set arr = Sheets(1).UsedRange.Offset(2)
ReDim t(1 To arr.Rows.Count * 5, 1 To 2)
    For i = 1 To arr.Rows.Count
        If UBound(Split(arr(i, 3), ",")) < 1 And Not IsEmpty(arr(i, 1)) Then
            x = x + 1
            t(x, 2) = arr(i, 1)
            t(x, 1) = arr(i, 3)
        Else
            For y = 0 To UBound(Split(arr(i, 3), ","))
                x = x + 1
                t(x, 2) = arr(i, 1)
                t(x, 1) = Split(arr(i, 3), ",")(y)
            Next
        End If
    Next
Sheets(2).[A1].Resize(x, 2) = t
    
    Worksheets("Лист2").Activate
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), FieldInfo:=xlTextFormat

    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Âðåìÿ"
    
Application.ScreenUpdating = 1
End Sub
Вот такой теперь у меня затык:

процедура TextToColumns форматирует мою ячейку в 3 вместо 2ух, время 23:00:00 она интерпретирует как 11:00:00 AM - получается 2 ячейки вместо одной.
Формулы "Left, Right", фиксированную длинну использовать нельзя. Что можете посоветовать?
GoreProgrammist вне форума Ответить с цитированием
Старый 23.11.2017, 15:09   #5
ПаВлА
Пользователь
 
Регистрация: 20.11.2017
Сообщений: 16
По умолчанию

Пост2 обновлён.
ПаВлА вне форума Ответить с цитированием
Старый 23.11.2017, 15:25   #6
GoreProgrammist
Пользователь
 
Регистрация: 13.07.2009
Сообщений: 52
По умолчанию

Цитата:
Сообщение от ПаВлА Посмотреть сообщение
Пост2 обновлён.
Спасибо!

Не компилируется, ругается на строке

Sheets(2).[A2].Resize(x, 3) = t

Application-defined or Object-defined Error
GoreProgrammist вне форума Ответить с цитированием
Старый 23.11.2017, 15:36   #7
GoreProgrammist
Пользователь
 
Регистрация: 13.07.2009
Сообщений: 52
По умолчанию

Цитата:
Сообщение от ПаВлА Посмотреть сообщение
Пост2 обновлён.
Всё получилось в новой книге, ещё раз спасибо.
GoreProgrammist вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сортировка по столбцам таблицы (MS Excel) nightofpromises Общие вопросы .NET 19 16.02.2018 17:02
Помогите пожалуйста разбить текст из строки по столбцам tata70 Microsoft Office Excel 2 22.11.2017 16:33
Текст по столбцам - не опознается пробел strannick Microsoft Office Excel 2 01.09.2013 00:30
как разделить текст из одной ячейки по столбцам evdss Microsoft Office Excel 2 30.11.2010 08:27
Помогите разнести текст ячейки по столбцам Vlad-S Microsoft Office Excel 4 14.08.2009 21:16