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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 11.02.2019, 16:20   #1
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию Разложить столбец на строки

Помогите сделать макрос - чтобы часть текста имеющегося в каждой строке можно было указать в шапке столбцов. И обработка шла добавлением в соответствующие строки оставшегося текста.

Не могу закачать файл с примером - выложил ссылку.
https://yadi.sk/i/HjYwy_DQMGiNWg
autostavrroute вне форума Ответить с цитированием
Старый 12.02.2019, 20:08   #2
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Подскажите не получается через штатную форму сайта загрузить файл xls и другие, что можно исправить?
autostavrroute вне форума Ответить с цитированием
Старый 12.02.2019, 20:53   #3
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Я акк новый создавал ((
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 14.02.2019, 07:32   #4
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Ума хватило только формулу накрутить. Будет обсчитывать долговасто при большой базе, но зато работает.
https://yadi.sk/i/8FdW-OfwJEMiEQ
autostavrroute вне форума Ответить с цитированием
Старый 14.02.2019, 12:00   #5
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

мсье знает толк в извращениях (с)

не до конца понял, что именно нужно, но код, внешне, делает то самое что на листе2
Код:
Sub GoBitchFaster()
    Dim ws As Worksheet
    Dim dic As Object
    Dim maxCol As Integer
    Dim maxRow As Integer
    Dim clm As Integer
    Dim rw As Integer
    Dim rwOut As Integer
    Dim rightPart As String
    Dim leftPart As String
    Set ws = ActiveSheet
    Set dic = CreateObject("Scripting.Dictionary")
    maxCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    For clm = ws.[j1].Column To maxCol
        If Not dic.Exists(ws.Cells(1, clm).Value) Then
            dic.Add Trim(ws.Cells(1, clm).Value), clm
        End If
    Next clm
    maxRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    rw = 3
    Do While rw <= maxRow
        If ws.Cells(rw, "A").Value = "[POI]" Then rwOut = rw: rw = rw + 1
        If InStr(Trim(ws.Cells(rw, "A").Value), "=") Then
            rightPart = Trim(Split(ws.Cells(rw, "A"), "=")(1))
            leftPart = Split(ws.Cells(rw, "A"), "=")(0) & "="
            If leftPart = "Data0=" Then leftPart = leftPart & "("
            If dic.Exists(Trim(leftPart)) Then
                ws.Cells(rwOut, dic(leftPart)).Value = rightPart
            End If
        End If
        rw = rw + 1
    Loop
    Set ws = Nothing
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 14.02.2019, 20:25   #6
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Спасибо за утилизацию извращений:
Немного подправил
Код:
Sub GoBitchFaster()
    Dim ws As Worksheet
    Dim dic As Object
    Dim maxCol As Integer
    Dim maxRow As Integer
    Dim clm As Integer
    Dim rw As Integer
    Dim rwOut As Integer
    Dim rightPart As String
    Dim leftPart As String
    Set ws = ActiveSheet
    Set dic = CreateObject("Scripting.Dictionary")
    maxCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    For clm = ws.[j1].Column To maxCol
        If Not dic.Exists(ws.Cells(1, clm).Value) Then
            dic.Add Trim(ws.Cells(1, clm).Value), clm
        End If
    Next clm
    maxRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    rw = 3
    Do While rw <= maxRow

        If ws.Cells(rw, "A").Value = "[POI]" Or ws.Cells(rw, "A").Value = "[POLYGON]" Then rwOut = rw: rw = rw + 1
        If InStr(Trim(ws.Cells(rw, "A").Value), "=") Then
            rightPart = Trim(Split(ws.Cells(rw, "A"), "=")(1))
            leftPart = Split(ws.Cells(rw, "A"), "=")(0) & "="
            If leftPart = "Data0=" Then leftPart = leftPart & "("
            If dic.Exists(Trim(leftPart)) Then
                ws.Cells(rwOut, dic(leftPart)).Value = rightPart
            End If
        End If
        rw = rw + 1
    Loop
    Set ws = Nothing
End Sub
Вопрос неработоспособности стоит в том что обрабатывает примерно 32000 строк - потом выдает ошибку "Переполнение (ошибка 6)"
autostavrroute вне форума Ответить с цитированием
Старый 14.02.2019, 21:20   #7
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от autostavrroute Посмотреть сообщение
обрабатывает примерно 32000 строк
Я бы даже сказал 32.767 последняя строка. Да?
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.

Последний раз редактировалось Aleksandr H.; 14.02.2019 в 21:29.
Aleksandr H. вне форума Ответить с цитированием
Старый 14.02.2019, 21:42   #8
autostavrroute
Пользователь
 
Регистрация: 07.06.2018
Сообщений: 40
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Я бы даже сказал 32.767 последняя строка. Да?
Скорее всего, есть что и как скорректировать?
autostavrroute вне форума Ответить с цитированием
Старый 14.02.2019, 21:51   #9
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Используйте более "вместительный" тип для переменных хранящих номера строк
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Протягивание данных из строки в столбец squit Microsoft Office Excel 11 05.07.2016 21:08
Замена строки на столбец в матрице РоманВас Visual C++ 4 30.03.2016 16:10
Как разложить строку на под строки? juan666777 Помощь студентам 2 27.01.2010 19:10
транспонирование строки таблицы в столбец kate158 БД в Delphi 15 18.05.2009 12:51
Умножение строки на столбец. ReDev1L Помощь студентам 6 21.10.2008 22:31