Трюк Excel для этой задачи

У меня есть таблица в excel с такими строками:

       COLUMN
Value1.Value2.Value3
Value4.Value5.Value6
Value7.Value8.Value9

В другой таблице у меня есть простой список с именами:

   COLUMN
    Name1
    Name2
    Name3

И, конечно же, этот список огромен :).

Поэтому в конце должна быть следующая таблица:

       COLUMN

Value1.Name1.Value2.Value3
Value4.Name1.Value5.Value6
Value7.Name1.Value8.Value9
Value1.Name2.Value2.Value3
Value4.Name2.Value5.Value6
Value7.Name2.Value8.Value9
Value1.Name3.Value2.Value3
Value4.Name4.Value5.Value6
Value7.Name4.Value8.Value9

Я должен объединить имена в списке со всеми значениями в электронной таблице, реплицируя их для ВСЕХ имен.

Есть ли способ сделать этот процесс автоматически? Ручной процесс занял бы часы, и я думаю, что есть более разумный способ сделать это, хотя я его не знаю! :)

Заранее спасибо за вашу помощь.


excel spreadsheet vba
person D. Caan    schedule 24.02.2014    source источник
comment
1) Вам нужно всегда добавлять NameI после первого . в столбце value? 2) Есть ли дубликаты в столбце Name 3) должно ли это быть решение VBA или формула?   -  person Dmitry Pavliv    schedule 24.02.2014
comment
@симоко 1) Да. 2) В столбце «Имя» нет дубликатов.   -  person D. Caan    schedule 24.02.2014
comment
3) должно ли это быть решение VBA или формула?   -  person Dmitry Pavliv    schedule 24.02.2014
comment
Далек, все ли ваши значения в столбце Values действительны? Я имею в виду, у них всегда есть .?   -  person Dmitry Pavliv    schedule 24.02.2014
comment
Всегда есть . между значениями. значения меняются, но всегда есть . между ними.   -  person D. Caan    schedule 24.02.2014

Ответы (3)


arrow_upward
1
arrow_downward

Всегда есть "." между значениями.

Попробуйте этот код. Использование массивов было бы намного быстрее для огромного списка имен/значений:

Sub test()
    Dim arrVal As Variant
    Dim arrNames As Variant
    Dim arrRes As Variant
    Dim v, n, k As Long

    'change Sheet1 to suit
    With ThisWorkbook.Worksheets("Sheet1")
        'change A1:A3 to values address
        arrVal = .Range("A1:A3")
        'change B1:B3 to names address
        arrNames = .Range("B1:B3")

        ReDim arrRes(1 To UBound(arrVal) * UBound(arrNames), 1 To 1)
        k = 1
        For Each v In arrVal
            For Each n In arrNames
                arrRes(k, 1) = Left(v, InStr(1, v, ".")) & n & Mid(v, InStr(1, v, "."))
                k = k + 1
            Next
        Next v

        'change "c1" to start cell where to put new values
        .Range("C1").Resize(UBound(arrRes, 1)) = arrRes
    End With
End Sub

Примечание. Если вы не знаете точных адресов диапазонов значений и имен, измените эту часть.

'change A1:A3 to values address
arrVal = .Range("A1:A3")
'change B1:B3 to names address
arrNames = .Range("B1:B3")

to

'change A1:A to "values" address
arrVal = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
'change B1:B to "names" address
arrNames = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)

В этом случае диапазоны "values" и "name" начинаются с A1 и B1 соответственно и заканчиваются последней непустой строкой в ​​столбцах A и B соответственно.

Результат:

введите здесь описание изображения

person Dmitry Pavliv    schedule 24.02.2014
comment
Я не знаю, сделал ли я что-то не так, но это дает мне ошибку Несоответствие типа в .Range(C1).Resize(UBound(arrRes)) = WorksheetFunction.Transpose(arrRes) - person D. Caan; 24.02.2014
comment
как следует из комментариев к вашему Q, этот код предполагает, что все значения в массиве arrVal = .Range("A1:A3") имеют .. Это правда? может быть, вы включили заголовки столбцов в адрес диапазона значений? - person Dmitry Pavliv; 24.02.2014
comment
У них есть .. Нет заголовка. - person D. Caan; 24.02.2014
comment
@Dalek, у функции Transpose были некоторые ограничения (ограничение длины массива). Я обновил свой ответ - теперь он должен работать - person Dmitry Pavliv; 24.02.2014

arrow_upward
2
arrow_downward

И это хорошая задача сделать это с формулами: :)

введите здесь описание изображения

С этой формулой массива в D1, а затем скопируйте вниз

=INDEX(LEFT($A$1:$A$4;FIND(".";$A$1:$A$4))&TRANSPOSE($C$1:$C$3)&RIGHT($A$1:$A$4;LEN($A$1:$A$4)-FIND(".";$A$1:$A$4)+1);1+INT((ROWS($D$1:D1)-1)/ROWS($C$1:$C$3));1+MOD(ROWS($D$1:D1)-1;ROWS($C$1:$C$3)))

В зависимости от региональных настроек вам может потребоваться заменить разделитель полей ";" к ","

person CRondao    schedule 24.02.2014
comment
Как человек, который уклоняется от подобных задач Excel Hero Formula, я все же должен сказать, что это серьезно приятно для глаз. +1! - person NullDev; 24.02.2014
comment
Копирование не работает для меня. Для первого ряда все нормально. Какой-то специальный конфиг для этого? - person D. Caan; 25.02.2014
comment
Если это работает для первой строки, возможно, у вас есть относительная ссылка, которая должна быть абсолютной или наоборот. Я попробовал еще раз, и это работает. Убедитесь, что ссылки точно равны. Никаких специальных конфигов. Или покажите мне формулу, которую вы используете. (Дважды подумав, вы нажали Ctrl Shift Enter, чтобы ввести формулу? Это формула массива) - person CRondao; 25.02.2014

arrow_upward
0
arrow_downward

Я думаю, это может сработать.

    Const FIRST_TALBE = 4
    Const SECOND_TABLE = 2

    Sub makeTheJob()
        For i = 1 To lastRow
            l = Split(Cells(i, FIRST_TABLE), ".")
            newvalue = l(0) & "." & Cells(i, SECOND_TABLE) & "." & l(1) & "." & l(2)
            Debug.Print newvalue
        Next i
    End Sub
person Makah    schedule 24.02.2014