Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Как переформатировать массив (А) в массив (B), связать коды из массива данных между собой в один массив из 2-х столбцов
 
Всем добрый день!

Прошу помощи у всех кто сможет помочь в одном очень деликатном вопросе.

Есть массив данных состоящий из разного количества столбцов в котором находятся данные - это одинаковые товары только с разными кодами товаров, так называемые аналоги.

Необходимо эти все коды которые находятся в разных столбцах перевязать парами между собой в одном массиве состоящем всего из 2- столбцов. К примеру есть 5 столбцов в котором 1 код (1 столбец) и 4 аналога (4 столбца) необходимо все коды связать парами между собой в один длинный массив. Все аналоги должны быть связаны парами друг с другом (1 код + 4 аналога) = 16 пар вниз.

Пример прикрепил.  
 
Здравствуйте. Вам нужен "Редизайнер таблиц", загляните в Приемы.
Изменено: gling - 24 Фев 2017 13:48:43
 
Выполните следующий код
Код
Sub MergeAnalog()
Dim arrA(), arrB()
Dim I&, J&, K&, N&
On Error Resume Next
arrA = Range("B4:F" & Cells(Rows.Count, 2).End(xlUp).Row).Value
For I = 1 To UBound(arrA, 1)
    For J = 1 To UBound(arrA, 2)
        For K = 1 To UBound(arrA, 2)
            If K <> J Then
                ReDim Preserve arrB(1, N)
                arrB(0, N) = arrA(I, J)
                arrB(1, N) = arrA(I, K)
                N = N + 1
            End If
        Next
    Next
Next
Range("L4").Resize(UBound(arrB, 2), 2) = Application.Transpose(arrB)
End Sub
Изменено: Sanja - 24 Фев 2017 16:12:25
Согласие есть продукт при полном непротивлении сторон.
 
Санечек!

Огромное спасибо тебе!!!!!!!
Мне теперь есть счастье!!!!!!!
 
Есть еще вопрос!
Если таких строк 8500 а столбцов 15. Надо что-то в коде менять??
 
В результирующем массиве не должно быть строк более чем строк на листе Excel соответствующей версии. Ну и диапазоны проверьте
Согласие есть продукт при полном непротивлении сторон.
 
В предпоследней строке кода единицу нужно прибавить

Range("L4").Resize(UBound(arrB, 2) + 1, 2) = Application.Transpose(arrB)
Согласие есть продукт при полном непротивлении сторон.
 
Цитата
Sanja написал: В результирующем массиве не должно быть строк более чем строк на листе Excel соответствующей версии.
У Вас их, кстати, получится больше: 8500 х 15 х 14 = 1 785 000.
А строк на листе 1 048 576
Изменено: Sanja - 24 Фев 2017 17:18:42
Согласие есть продукт при полном непротивлении сторон.
 
Что делать? Как быть???  Во вложении реальный пример!

Может существует другой способ??
Там не во всех 15 столбцах есть значения, много пустых ячеек.
Может это поможет?  
Изменено: Evgewik87 - 24 Фев 2017 18:56:03
 
Из ваших 64х16 ячеек получилось 250... ;) См. запрос PQ.
ps Но, скорее всего, надо к другой проге обратиться или же дробить/править/сшивать.
Изменено: Z - 24 Фев 2017 18:28:34
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Спасибо за подсказку.

Наверное буду дробить/править/сшивать
 
Sanja,

Можете макрос поправить под мой "реальный пример"?

Буду очень благодарен.


P.S. Совсем не разбираюсь в кодах макросов.
 
 
Evgewik87, Вы можете по человечески сообщения писать? Надоело убирать после Вас пустые лишние строки.
Какой смысл в отделении  обращения к собесднику от текста?
 
Сори. Исправлюсь!
 
 
Цитата
Evgewik87 написал:
Исправлюсь!
Приступайте )
 
Доброе время суток.
Цитата
Z написал:
См. запрос PQ
В нашем полку прибыло!
 
А мы всё по-старинке  :)
Код
Sub MergeAnalog()
Dim arrB(), arrTemp()
Dim I&, J&, K&, N&
On Error Resume Next
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For I = 4 To lRow
    arrTemp = Range(Cells(I, 1), Cells(I + 3, Rows(I).Find(Empty).Column - 1)).Value
    For J = 1 To UBound(arrTemp, 2)
        For K = 1 To UBound(arrTemp, 2)
            If K <> J Then
                ReDim Preserve arrB(1, N)
                arrB(0, N) = arrTemp(1, J)
                arrB(1, N) = arrTemp(1, K)
                N = N + 1
            End If
        Next
    Next
    Erase arrTemp
Next
Range("R4").Resize(UBound(arrB, 2) + 1, 2) = Application.Transpose(arrB)
End Sub
Если и в этом варианте не хватит строк на листе, можно разбивать результирующий массив на несколько пар столбцов с нужным количеством строк
Изменено: Sanja - 25 Фев 2017 10:16:31
Согласие есть продукт при полном непротивлении сторон.
 
Александр, огромное спасибо!
Проверил на файле, все работает!
Выручили меня очень сильно. Огромное спасибо!!!!!!!!!!!!!!
Страницы: 1
Читают тему (гостей: 1)