Excel 宏删除包含可变文本的行

Question

这是我第一次发帖。

我试图在 Excel 2016 年找到一种方法来清理文件夹列表，以便我只有父文件夹。

我有一个电子表格，其中 A 列是文件夹列表，包括它们的子文件夹。像这样：[fyi - 每行中还有其他列，但它们与此示例无关]

\server\share\root\subfolder1\
\server\share\root\subfolder1\sub-subfolderA\
\server\share\root\subfolder1\sub-subfolderB\
\server\share\root\subfolder1\sub-subfolderC\
\server\share\root\subfolder2\
\server\share\root\subfolder2\other-subfolderA\
\server\share\root\subfolder2\other-subfolderB\
\server22\share\root\subfolder3\ham_sandwich\
\server22\share\root\subfolder3\ham_sandwich\yet-another-subfolderA\
\server22\share\root\subfolder3\and-another-subfolderA\
\server22\share\root\subfolder3\and-another-subfolderB\

大约有 2500 行不同长度的文件夹，我的最终目标是最终只包含每个 "set" 的顶级文件夹。例如：

\server\share\root\subfolder1\
\server\share\root\subfolder2\
\server22\share\root\subfolder3\ham_sandwich\
\server22\share\root\subfolder3\and-another-subfolderA\
\server22\share\root\subfolder3\and-another-subfolderB\

我的逻辑如下（如有遗漏请指正）：

See if the string in A1 is contained within the string in A2.
  If A2 contains the string, delete row 2.
  If it doesn't, move down to compare A2 with A3. [since we know A1 is now the only cell containing that top folder]
Rinse-and-repeat until the last populated row is reached.

我的问题是找出代码。我在网上看到各种关于搜索指定文本的代码片段，但没有使用变量的代码片段。我最初是在玩弄 IsNumber 和 Search 的公式组合，但它需要固定的文本来搜索，这会随着宏的进行而改变。

有人可以为此指出正确的方向吗？

Answer 1

假设顶级文件夹总是列在子文件夹之前：

k = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = k - 1 To 1 Step -1
    For j = k To i + 1 Step -1
        If InStr(Range("A" & j), Range("A" & i)) > 0 Then
            Rows(j).Delete
            k = k - 1
        End If
    Next j
Next i

Answer 2

如果列表很长，使用 VBA 数组处理列表会比重复工作表 read/writes.

更快

宏假设数据按您显示的那样排序。如果没有，先添加例程排序。

我们遍历每个项目，并检查是否可以找到之前存储的项目。基于此，我们确定是否将结果存储在我们的字典中。然后我们将其输出到工作表。

您可以在代码中看到您可以在何处改变要处理的范围以及您希望在何处获得结果。

'Set reference to Microsoft Scripting Runtime
Option Explicit
Sub cleanList()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim dList As Dictionary
    Dim V, I As Long

Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet1")
    Set rRes = wsRes.Cells(1, 2) 'results in column B

'Assume data starts in A1
'Read into variant array for speed of processing
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

'collect results
Set dList = New Dictionary
    dList.CompareMode = TextCompare

For Each V In vSrc
    If dList.Count = 0 Then
        dList.Add Key:=V, Item:=V
    ElseIf InStr(V, dList.Keys(dList.Count - 1)) = 0 Then
            dList.Add Key:=V, Item:=V
    End If
Next V

'create results array
ReDim vRes(1 To dList.Count, 1 To 1)
I = 0
For Each V In dList
    I = I + 1
    vRes(I, 1) = V
Next V

'set results range
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1))

'write results to worksheet
With rRes
    .EntireColumn.Clear
    .Value = vRes
    .EntireColumn.AutoFit
End With

End Sub

Answer 3

可能的解决方案之一（基于您的数据集）：

Sub test()
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim rng As Range: Set rng = Range([A1], Cells(Rows.Count, "A").End(xlUp))
    Dim cl As Range, x As Variant, cntr&: cntr = 0

    dic.Add cntr, rng.Cells(1).Value2: cntr = cntr + 1
    For Each cl In rng
        If Not LCase(cl.Value2) Like LCase(dic(cntr - 1)) & "*" Then
            dic.Add cntr, cl.Value2: cntr = cntr + 1
        End If
    Next cl

    For Each x In dic
        Debug.Print dic(x)
    Next x
End Sub

测试如下：

Excel 宏删除包含可变文本的行

Excel macro to remove rows containing variable text

excel

vba

search

delete-row

excel-2016