Перемещение каждого значения в определенную ячейку - PullRequest
Новая
       11

Перемещение каждого значения в определенную ячейку

0 голосов
/ 06 ноября 2018

У меня есть список контактов с более чем 4000 строк. Проблема в том, что каждый идентификатор на одного человека был продублирован, в каждой дублированной строке хранятся альтернативные контактные данные, такие как мобильный, рабочий телефон. Что мне нужно сделать, так это сделать уникальные 1d в одном столбце с последующей работой, работой 2, домом 2, мобильным телефоном, мобильным телефоном 2 и т. Д. В одной строке, а это будет ниже.

Мне было интересно, есть ли способ сделать для каждого значения в типе телефона работы 2 переход к рабочей ячейке отца (I2) на снимке экрана.

Поскольку вырезать и вставлять каждую ячейку, чтобы поместить их в назначенные ячейки, отнимает много времени

Спасибо.

enter image description here

Ответы [ 2 ]

0 голосов
/ 09 ноября 2018

Вы можете использовать формулу массива с INDEX и MATCH. Этот пример относится к столбцу «Материнская работа» - и я предполагаю, что фактический номер телефона будет в столбце P.

=INDEX($P:$P,MATCH($C2&N$1,$C:$C&$H:$H,0))

Удостоверьтесь, что нажали CTRL + SHIFT + ENTER, а не просто ENTER, чтобы зафиксировать формулу - поскольку для работы должна быть формула массива.

Если вы поместите эту формулу в N2, она будет искать что-то с идентификатором в C2 и текстом из N1 в столбце C и столбце H соответственно - и вернет значение из столбца P соответствующей строки.

0 голосов
/ 06 ноября 2018

Примерно так будет транспонировать ваши данные, он создает фиктивный столбец, который подсчитывает основной идентификатор и какие строки удаляются.

Код VBA: 

Sub TransposeData()

Dim ws As Worksheet
Dim lrow As Long
Dim i As Long
Dim j As Long
Dim myRange As Range
Dim cl As Variant
Dim count As Long
Dim cel As Range
Dim delRng As Range

Set ws = ActiveWorkbook.Worksheets("Sheet1") 'Set worksheet name

ws.Cells(1, 20).Value = "DelRC" 'dummy Column
lrow = ws.Cells(Rows.count, 1).End(xlUp).Row 'Find last row
Set myRange = Range(ws.Cells(2, 8), ws.Cells(lrow, 8)) 'Loop range


For Each cl In myRange 'Loop through range
    If ws.Cells(cl.Row - 1, 3).Value = ws.Cells(cl.Row, 3).Value Then 'Check id - 1 = id
        ws.Cells(cl.Row, 20).Value = 1 'Print dummy
    ElseIf ws.Cells(cl.Row - 1, 3).Value <> ws.Cells(cl.Row, 3).Value Then 'Check id - 1 <> id
        count = ws.Cells(cl.Row, 3).Row 'Store first id location
    End If
    If ws.Cells(cl.Row, 19).Value <> "Home" Then 'Home = skip loop
        Select Case ws.Cells(cl.Row, 19).Value 'Check value
        Case "Work" 'Work -> paste to Mother Work
            ws.Cells(count, 14).Value = ws.Cells(cl.Row, 8).Value 'Copy and paste
        Case "Work2" 'Work2 -> paste to Father Work
            ws.Cells(count, 9).Value = ws.Cells(cl.Row, 8).Value 'Copy and paste
        Case "Mobile" 'Mobile -> paste to Mother Mobile
            ws.Cells(count, 13).Value = ws.Cells(cl.Row, 8).Value 'Copy and paste
        Case "Mobile2" 'Mobile2 -> paste to Father Mobile
            ws.Cells(count, 14).Value = ws.Cells(cl.Row, 8).Value 'Copy and paste
        End Select
    End If
Next cl
Set myRange = myRange.Offset(0, 12)
For Each cel In myRange
    If cel.Value = 1 Then
        If delRng Is Nothing Then
            Set delRng = cel
        Else
            Set delRng = Union(delRng, cel)
        End If
    End If
Next cel
If Not delRng Is Nothing Then delRng.EntireRow.Delete 'Delete dummy column and all rows = 1
ws.Cells(1, 20).Value = ""
End Sub
...