Question

这是我第一次发布。

我正在尝试在Excel 2016中找到一种清理文件夹列表的方法，以便我只有父文件夹。

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

Type

大约有2500行带有不同长度的文件夹，我的最终目标是最终只保留每个“集合”的顶层文件夹。例如：

class booking_period(models.Model):
    booking_period_start = models.DateField(auto_now=False)
    booking_period_end = models.DateField(auto_now=False)
    booking_person_name = models.CharField(max_length=200)


class Furniture(models.Model):
    furniture_type = models.CharField(max_length=200)
    furniture_owner_name = models.CharField(max_length=200)
    furniture_booking = models.ManyToManyField(booking_period)

    def __str__(self):
        return self.furniture_type

我对此的逻辑如下（如果我忽略任何内容，请纠正我）：

\\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\

我的问题是为此找到代码。我在网上看到各种有关搜索指定文本的代码段，但没有使用变量的代码段。我本来是想把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数组处理列表会更快，而不是重复读取/写入工作表。

您所显示的宏将对数据进行排序。如果不是，请添加一个例程以对其进行排序。

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

您可以在代码中看到可以在何处更改处理范围以及在何处想要结果。

'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宏删除包含可变文本的行

3 个答案: