单列数据转换成数据库表格式

Question 1

这是一个不使用 VBA 的解决方案。（剧透警告：它并不完整，可以使用 VBA 来完成。）

我假设：

您现有的数据位于列中 A，从单元格开始 A1，并且
[名称] 值永远不能以“+”或数字开头。

我们将数据放入到的列 M中P。

Name Company Email Phone在单元 M1格中输入标题至P1。
在单元格中 L2输入1（数字一）。
在单元格中 K2输入=IF(L2<=0, "", LEFT(INDEX(A:A, L2+3),1))。
在单元格中 L3输入=IF(K2="", 0, IF(OR(K2="+",AND(K2>="0",K2<="9")), L2+4, L2+3))。
在单元格中 M2输入=IF($L2=0, "", INDEX($A:$A, $L2))。
在单元格中 N2输入=IF($L2=0, "", INDEX($A:$A, $L2+1))。
在单元格中 O2输入=IF($L2=0, "", INDEX($A:$A, $L2+2))。
在单元格中 P2输入=IF(OR($L2=0,$L3=$L2+3,$L3=0), "", INDEX($A:$A, $L2+3))。
如果你不知道有多少条记录，那就估计一下。取原始数据的行数（我们称之为米）并除以 3，四舍五入。称这个数字为否。由于每条记录至少有 3 行，因此最多可以有否 / 3 条记录。
选择L3并拖动/填充至行否+1。（这给了我们否行，因为第 1 行没有数据。）
选择K2并拖动/填充至行否+1。
选择M2:P2并拖动/填充至行否+1。

你应该有类似这样的内容：

如果您有许多四行记录（即带有电话号码的记录），那么您的数据下方可能会有几行带有零的记录。在 Excel 中引用空白单元格时显示空白讨论了一些抑制这些方法的方法，但更明智的做法是复制有效数据（ M1:P5上面例子中的单元格）并粘贴值。

电子邮件地址不会自动呈现为超链接。如果您的数据库不是很大，您可以使用此手动方法将其转换为超链接：

单击第一个（单元格 O2）。
按F2。按Enter。
重复步骤 2，直到到达数据末尾。

如果你不想这样做，你可以使用如何将 Excel 中的纯文本链接转换为超链接？和如何将 Excel 中的数百个文本 URL 转换为可点击的超链接？（其中大部分涉及 VBA）。

Answer

这是一个不使用 VBA 的解决方案。（剧透警告：它并不完整，可以使用 VBA 来完成。）

我假设：

您现有的数据位于列中 A，从单元格开始 A1，并且
[名称] 值永远不能以“+”或数字开头。

我们将数据放入到的列 M中P。

Name Company Email Phone在单元 M1格中输入标题至P1。
在单元格中 L2输入1（数字一）。
在单元格中 K2输入=IF(L2<=0, "", LEFT(INDEX(A:A, L2+3),1))。
在单元格中 L3输入=IF(K2="", 0, IF(OR(K2="+",AND(K2>="0",K2<="9")), L2+4, L2+3))。
在单元格中 M2输入=IF($L2=0, "", INDEX($A:$A, $L2))。
在单元格中 N2输入=IF($L2=0, "", INDEX($A:$A, $L2+1))。
在单元格中 O2输入=IF($L2=0, "", INDEX($A:$A, $L2+2))。
在单元格中 P2输入=IF(OR($L2=0,$L3=$L2+3,$L3=0), "", INDEX($A:$A, $L2+3))。
如果你不知道有多少条记录，那就估计一下。取原始数据的行数（我们称之为米）并除以 3，四舍五入。称这个数字为否。由于每条记录至少有 3 行，因此最多可以有否 / 3 条记录。
选择L3并拖动/填充至行否+1。（这给了我们否行，因为第 1 行没有数据。）
选择K2并拖动/填充至行否+1。
选择M2:P2并拖动/填充至行否+1。

你应该有类似这样的内容：

如果您有许多四行记录（即带有电话号码的记录），那么您的数据下方可能会有几行带有零的记录。在 Excel 中引用空白单元格时显示空白讨论了一些抑制这些方法的方法，但更明智的做法是复制有效数据（ M1:P5上面例子中的单元格）并粘贴值。

电子邮件地址不会自动呈现为超链接。如果您的数据库不是很大，您可以使用此手动方法将其转换为超链接：

单击第一个（单元格 O2）。
按F2。按Enter。
重复步骤 2，直到到达数据末尾。

如果你不想这样做，你可以使用如何将 Excel 中的纯文本链接转换为超链接？和如何将 Excel 中的数百个文本 URL 转换为可点击的超链接？（其中大部分涉及 VBA）。

Question 2

如果您愿意接受 VBA 解决方案，那么它相对简单，尽管代码有些复杂。

算法取决于：

手机是唯一可选组件
所有组件都按固定顺序排列
没有空行

因此我们

循环遍历数据
总是提取前三个作为姓名、公司、电子邮件
测试第四行，看看它是否以 a+或 a开头digit
- 如果是，则将其作为手机号存储，并将这四个作为一行存储在字典中
- 如果不是，则将前三个作为一行存储在字典中

为了方便、易懂和速度 - 我创建了一个类对象来保存数据 - 我创建了一个字典来保存不同的类对象 - 我使用正则表达式来决定可选的电话号码条目是否与模式匹配 - 我使用 VBA 数组而不是直接在工作表上工作因为这大约快 10 倍。

要输入此宏（子），alt-F11请打开 Visual Basic 编辑器。

确保您的项目在“项目资源管理器”窗口中突出显示。

然后，从顶部菜单中选择插入/模块或者插入/分类模块并将下面的适当代码粘贴到打开的窗口中。

如果您的工作表名称和所需范围不符合您的要求，请在代码中进行相应编辑。代码假定您的数据源从开始A1，Sheet1结果将从A1开始Sheet2

请务必设置常规模块顶部注释中提到的适当参考Tools/References，然后选择它们

要使用此宏（子），请打开宏对话框。按名称选择宏，然后RUN。

类模块

Option Explicit
Private pName As String
Private pCompany As String
Private pEmail As String
Private pPhone As Variant

Public Property Get Name() As String
    Name = pName
End Property
Public Property Let Name(Value As String)
    pName = Value
End Property

Public Property Get Company() As String
    Company = pCompany
End Property
Public Property Let Company(Value As String)
    pCompany = Value
End Property

Public Property Get Email() As String
    Email = pEmail
End Property
Public Property Let Email(Value As String)
    pEmail = Value
End Property

Public Property Get Phone() As Variant
    Phone = pPhone
End Property
Public Property Let Phone(Value As Variant)
    pPhone = Trim(CStr(Value))
End Property

常规模块

'Set Reference to Microsoft Scripting Runtime
'set reference to Microsoft Regular Expressions 5.5
Option Explicit
Sub dataTable()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim cD As cData, dD As Dictionary
    Dim RE As RegExp
    Dim IDX As Long
    Dim I As Long, key As Variant

Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
    Set rRes = wsRes.Cells(1, 1)

With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set dD = New Dictionary
Set RE = New RegExp
With RE
    .Pattern = "\s*[+\d]"
    .Global = False
End With

For I = 1 To UBound(vSrc, 1)
    If I = 1 Then
        Set cD = New cData
        IDX = 0
    End If
        With cD
            .Name = vSrc(I, 1)
            .Company = vSrc(I + 1, 1)
            .Email = vSrc(I + 2, 1)
            If I + 3 > UBound(vSrc, 1) Then Exit For
            If RE.Test(vSrc(I + 3, 1)) Then
                    .Phone = vSrc(I + 3, 1)
                    I = I + 3
                Else
                    I = I + 2
                End If
            IDX = IDX + 1
            dD.Add key:=IDX, Item:=cD
        End With
        Set cD = New cData
Next I

ReDim vRes(0 To dD.Count, 1 To 4)
    vRes(0, 1) = "Name"
    vRes(0, 2) = "Company"
    vRes(0, 3) = "Email"
    vRes(0, 4) = "Phone"

For Each key In dD.Keys
    With dD(key)
        vRes(key, 1) = .Name
        vRes(key, 2) = .Company
        vRes(key, 3) = .Email
        vRes(key, 4) = .Phone
    End With
Next key

Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Columns(4).NumberFormat = "@"
    .Value = vRes

    'add the hyperlinks
    Dim c As Range
    For Each c In .Columns(3).Cells
        If InStr(c.Text, "@") > 0 Then
            c.Hyperlinks.Add c, c.Text
        End If
    Next c
    .Style = "Output"
    .EntireColumn.AutoFit
End With

End Sub

原始数据

处理的数据

Answer