将每个值移动到某个单元格中

Question

我有超过4000行的联系人列表。问题是每个人的每个ID都有重复，每个重复的行都存储备用的联系方式，例如手机，办公电话。我需要做的是通过同一行中的后续工作（work2，home 2，mobile 2，mobile 2等）在一列中创建唯一的1d，而不是在下面。

我想知道是否存在一种方法，对于工作2电话类型中的每个值，请移至屏幕截图中的父工作单元为（I2）。

剪切并粘贴每个单元格以将其放入指定的单元格非常耗时

谢谢。

Answer 1

像这样的事情会转置您的数据，它会创建一个虚拟列来计算主ID和要删除的行。

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

Answer 2

您可以将数组公式与INDEX和MATCH一起使用。此示例用于“母亲工作”列-我猜测实际的电话号码将在“ P”列中。

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

请确保按CTRL + SHIFT + ENTER而不是ENTER来提交公式-因为它必须是数组公式才能起作用。

如果将此公式放在N2中，它将在C2中查找ID，并在C列和H列中分别查找N1中的文本，然后从匹配行的P列中返回值。