从Excel中的4列生成单列列表

我正在为一个web表单建立一个下拉列表。表单中父项和子项的格式非常具体，并遵循以下模式

Parent
-Child 1
--Child 2
---Child 3

（连字符等于空格）

我收到一份Excel电子表格，其中包含以下简短示例中的数据

省 孤岛 地区议会 水系 马拉帕 马莱库拉 马莱库拉市中心 威斯康星州 马拉帕 马莱库拉 东南马莱库拉 乌阿克特普酒店 马拉帕 马莱库拉 东北马莱库拉 乌阿拉瓦斯酒店 马拉帕 马莱库拉 西北马莱库拉 乌阿尔巴迪酒店 马拉帕 马莱库拉 西北马莱库拉 乌阿勒姆图酒店 马拉帕 马莱库拉 西北马莱库拉 乌阿尔卡库酒店 马拉帕 马莱库拉 西北马莱库拉 乌阿努阿塔赫酒店 马拉帕 马莱库拉 东南马莱库拉 面纱 马拉帕 琥珀 东南安布里姆 WS_Ase 马拉帕 马莱库拉 东南马莱库拉 瓦苏·阿索洛克 马拉帕 马莱库拉 东南马莱库拉 乌阿森 彭纳马省 五旬节 北五旬节 W_Nambwarangiut 彭纳马省 安贝 西安贝 瓦努纳科酒店 彭纳马省 迈沃岛 北马沃 南通加酒店 彭纳马省 安贝 西安贝 W_Nangweangwea 三马 马洛 东马洛 瓦努纳维奥瓦酒店 三马 桑托 北圣托 努纳瓦罗塔酒店 三马 桑托 南圣多 瓦努纳沃塔农场 三马 桑托 北圣托 乌纳维拉酒店 三马 马洛 西马洛 乌纳温布酒店 三马 桑托 西北圣托 新宿

---

这个问题与我通常在这里看到的有点不同，所以我想我应该从VBA解决方案的角度来看一下。我相信下面给出的例子有一个更优雅的解决方案，但这就是我想到的

它假定您的数据位于

表1

的

A:D列中，并且该表的其余部分可用作辅助列等。所需的输出放在
F列中

Option Explicit
Sub ParentChild()
On Error GoTo GetOut
Dim LastRow As Long, i As Long, rng As Range, c As Range

Application.ScreenUpdating = False

LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

'Create a copy of the data to restore to the original format
Sheet1.Range("A1:D" & LastRow).Copy Sheet1.Range("K1")

'Concatenate with delimiter, add spaces, sort & replace cols A:D values
'using the built-in TextToColumns function
With Sheet1.Range("F2:F" & LastRow)
    .FormulaR1C1 = "=RC1&"", ""&RC2&"",  ""&RC3&"",   ""&RC4"
    .Value = .Value
    .Sort Key1:=Sheet1.Range("F2"), order1:=xlAscending
    Application.DisplayAlerts = False
    .TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1))
    Application.DisplayAlerts = True
    .Clear
End With

'Delete sequential 'parents'
Set rng = Sheet1.Range("A2:D" & LastRow)

For i = rng.Cells.Count To 1 Step -1
If rng.Item(i) = rng.Item(i).Offset(-1) Then
    rng.Item(i).ClearContents
End If
Next i

Sheet1.Columns("F:F").ColumnWidth = 25

'Copy to new column
i = 2
For Each c In Sheet1.Range("A2:D" & LastRow)
    If c.Value = "" Then GoTo Skip
        c.Copy Sheet1.Cells(i, 6)
        i = i + 1
Skip:
Next c

'Restore original format
Sheet1.Range("K1:N" & LastRow).Copy Sheet1.Range("A1")
Sheet1.Range("K1:N" & LastRow).Clear

Continue:
    Application.ScreenUpdating = True
    Exit Sub
GetOut:
    MsgBox Err.Description
    Resume Continue

End Sub

我不会使用
VLOOKUP
，但公式或
VBA
甚至
powerquery
都应该可以工作。你试过什么？这不是一个免费的代码编写服务，但我们可以帮助您使用复杂的公式或您试图开发的代码。我建议您阅读的帮助主题，以及。然后编辑你原来的问题来改进它，或者问一个新的问题，如果原来的问题已经结束了。这是一个令人惊讶的回答，我非常感谢你。工作很棒，也教会了我很多。干杯，凯文！不客气，本。