从 Excel 中的 4 列构建单列列表

Question

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

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

（连字符等于空格）

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

Province	Island	Area Council	Water System
Malampa	Malekula	Central Malekula	WS_Aim
Malampa	Malekula	South East Malekula	WS_Aktep
Malampa	Malekula	North East Malekula	WS_Alavas
Malampa	Malekula	North West Malekula	WS_Albatei
Malampa	Malekula	North West Malekula	WS_Alemtu
Malampa	Malekula	North West Malekula	WS_Alkakau
Malampa	Malekula	North West Malekula	WS_Anuatakh
Malampa	Malekula	South East Malekula	WS_Aout Veil
Malampa	Ambrym	South East Ambrym	WS_Ase
Malampa	Malekula	South East Malekula	WS_Asorok
Malampa	Malekula	South East Malekula	WS_Assen
Penama	Pentecost	North Pentecost	WS_Nambwarangiut
Penama	Ambae	West Ambae	WS_Nanako
Penama	Maewo	North Maewo	WS_Nandunga
Penama	Ambae	West Ambae	WS_Nangweangwea
Sanma	Malo	East Malo	WS_Naviova
Sanma	Santo	North Santo	WS_Navnaurota
Sanma	Santo	South Santo	WS_Navota Farm
Sanma	Santo	North Santo	WS_Nawelala
Sanma	Malo	West Malo	WS_Nawiambu
Sanma	Santo	North West Santo	WS_Nokuku

我想知道如何最好地使用 Excel 将此数据格式化为所需的模式。我很高兴使用公式、VLOOKUP 和/或 VBA.

示例数据的输出如下...

    Malampa
     Ambrym
      South East Ambrym
       WS_Ase
     Malekula
      Central Malekula
       WS_Aim
      North East Malekula
       WS_Alavas
      North West Malekula
       WS_Albatei
       WS_Alemtu
       WS_Alkakau
       WS_Anuatakh
      South East Malekula
       WS_Aktep
       WS_Aout Veil
       WS_Asorok
       WS_Assen
    Penama
     Ambae
      West Ambae
       WS_Nambwarangiut
       WS_Nanako
       WS_Nangweangwea
     Maewo
      North Maewo
       WS_Nandunga
     Pentecost
      North Pentecost
       WS_Nambwarangiut
    Sanma
     Malo
       WS_Naviova
      West Malo
       WS_Nawiambu
      North Santo
       WS_Navnaurota
       WS_Nawelala

提前致谢

Answer 1

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

它假定您的数据位于 Sheet1 列 A:D 中，并且 sheet 的其余部分可用作辅助列等。所需的输出被放入在 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

从 Excel 中的 4 列构建单列列表

Build single column list from 4 columns in Excel

excel

vba

vlookup