Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Несколько значений в ячейке разбить по строкам, Ключевое поле таблицы содержит несколько значений
 
#1
20.05.2017 13:51:19
День добрый. Получаю выгрузки в формате excel. Обрабатываю данные в access. Столкнулся с проблемой. Поле которое является в моей базе ключом, часто содержит несколько значений через запятые. Соответственно на таких строчках связь в базе не работает. Необходимо нормализовать таблицу - продублировать строчки столько раз сколько ключей в ячейке и присвоить таким строчкам ключи из этой ячейки. Представляется оптимальным решать проблему в excel, до импорта в access. Может были у кого похожие задачи? Не знаю с какого бока подступиться - может инструментом разбить по столбцам? а дальше?... Объем 10 кило строк. Прошу помощи.
Изменено: zuikovod - 20.05.2017 13:52:15
 
 
 
#2
20.05.2017 15:33:41
Цитата
zuikovod написал: Не знаю с какого бока подступиться
Макрос Вам в помощь
Код
Sub ReTable()
Dim arrVal(), arrTemp()
Dim I&, J&, N&
On Error Resume Next
arrVal = Range("A2:C" & Cells(Rows.Count, 2).End(xlUp).Row).Value
For I = 1 To UBound(arrVal)
    Key = Split(arrVal(I, 2), ",")
    For J = 0 To UBound(Key)
        ReDim Preserve arrTemp(2, N)
        arrTemp(0, N) = arrVal(I, 1)
        arrTemp(1, N) = Key(J)
        arrTemp(2, N) = arrVal(I, 3)
        N = N + 1
    Next
Next
Range("E2").Resize(UBound(arrTemp, 2) + 1, 3) = Application.Transpose(arrTemp)
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
20.05.2017 15:39:33
за основу можете взять код из #30 Разбить текст в ячейке по строкам через произвольный разделитель
и доработать под свои реалии... или в Раздел Работа
код символа вашей запятой 44
узнаётся формулой из вашего файла =КОДСИМВ(ПСТР(B28;8;1))
p.s.  для
Цитата
zuikovod написал:Объем 10 кило строк
можете пробовать и PowerQuery ...
p.s. предыдущий ответ не видела
Изменено: JeyCi - 20.05.2017 15:43:15
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#4
22.05.2017 00:58:55
Sanja, JeyCi, Спасибо большое за помощь. На примере работает как надо.
Попытка настроить под боевую задачу: 113 полей, резать данные в первом поле, вставлять на тоже место. Есть пустые ячейки в первом поле (вставил ииф), лишние пробелы после запятых. Код не работает - вообще ничего не происходит.
Код
Sub ReTable()
Dim arrVal(), arrTemp()
Dim I&, J&, N&, R&
On Error Resume Next
arrVal = Range("A2:DI" & Cells(Rows.Count, 2).End(xlUp).Row).Value
For I = 1 To UBound(arrVal)
    Key = IIf(arrVal(I, 1) <> "", trim(Split(arrVal(I, 1), ",")), "")
    For J = 0 To UBound(Key)
            ReDim Preserve arrTemp(112, N)
             arrTemp(0, N) = Key(J)
             For R = 2 To 113
             arrTemp(R - 1, N) = arrVal(I, R)
             Next
        N = N + 1
    Next
Next
Range("A2").Resize(UBound(arrTemp, 112) + 1, 113) = Application.Transpose(arrTemp)
End Sub
Где то ошибочка, может не одна. Поможете?

Не могу понять вот эту строчку, мне кажется в ней проблема
Код
Range("A2").Resize(UBound(arrTemp, 112) + 1, 113) = Application.Transpose(arrTemp)
 
 
 
#5
22.05.2017 12:32:45
Цитата
zuikovod написал: Поможете?
Вы бы приложили файл в, более менее, РЕАЛЬНОЙ СТРУКТУРЕ. 113 столбцов не надо, конечно, а вот столбец, в котором 'резать данные' должен быть на том-же месте и , примерно, в том-же виде (с пустыми значениями), ч то и в боевых данных. И что делать если ключевая ячейка пуста
Ну а пока, как-то так
Код
Sub ReTable()
Dim arrVal(), arrTemp()
Dim I&, J&, N&, R&
On Error Resume Next
arrVal = Range("A2:DI" & Cells(Rows.Count, 1).End(xlUp).Row).Value
For I = 1 To UBound(arrVal)
    Key = Split(Trim(arrVal(I, 1)), ",")
    keyCount = IIf(UBound(Key) = -1, 0, UBound(Key))
    For J = 0 To keyCount
        ReDim Preserve arrTemp(112, N)
        arrTemp(0, N) = IIf(UBound(Key) = -1, Empty, Key(J))
        For R = 1 To 112
            arrTemp(R, N) = arrVal(I, R + 1)
        Next
        N = N + 1
    Next
Next
Range("A2").Resize(UBound(arrTemp, 2) + 1, 113) = Application.Transpose(arrTemp)
End Sub
Изменено: Sanja - 22.05.2017 12:57:49
Согласие есть продукт при полном непротивлении сторон
 
 
 
#6
22.05.2017 18:36:49
Спасибо большое!
 
 
 
Страницы: 1
Наверх