☰

从 Excel 中的文件夹路径中提取字符

tag-icon • tag-icon microsoft-excel vba
从 Excel 中的文件夹路径中提取字符

我在 Excel 工作表中有一个很大的文件夹路径列表，以文本形式显示，我想从中提取每个反斜杠后的数字。然后需要将这些数字编译成一个缩短的引用。例如：

原始链接（假设在单元格 A1 中）：

c:\1_Folder\2_Folder\3_Folder

缩写参考（期望结果）：

1.2.3

如果我错了请纠正我，但我认为使用公式无法做到这一点。如果需要使用 VBA，这远远超出了我目前的技能。

您能提出一个解决方案吗？

答案1

此 VBA 将执行您想要的操作。请注意，我的示例仅查看了单元格A1-A10您需要更新它以反映您的需要（单元格范围）！

如果您不知道如何执行此操作，请将开发人员添加到功能区。在控件中，单击插入并添加按钮。添加新宏。在子例程中插入以下内容...

    Dim i As Integer
    i = 1
    For Each c In Worksheets("Sheet1").Range("A1:A10").Cells 'UPDATE THIS ROW ONLY WITH THE RANGE YOU WANT TO USE. This loops through all the cells in the range
        Dim resultsString As String
        resultsString = ""
        Dim splitString() As String
        splitString = Split(c, "\") ' split the value of the current cell by \

        For Each v In splitString
            If v <> "" Then 'only check those with a value
                Dim numberOfDigits As Integer
                numberOfDigits = 0
                For charCount = 1 To Len(v)
                    If IsNumeric(Left(v, charCount)) Then
                        numberOfDigits = charCount ' read how many characters there are (which are numbers)
                    End If
                Next

                If (numberOfDigits > 0) Then
                    resultsString = resultsString & Left(v, numberOfDigits) & "." 'if there are numbers, then read that number of digits from the left
                End If
            End If
        Next

        Dim iLength As Integer
        iLength = Len(resultsString)
        If (iLength > 0) Then ' if there are any values
            Range("B" & i).Value = Left(resultsString, iLength - 1) 'UPDATE THIS ROW ONLY IF YOU WANT TO USE A DIFFERENT COLUMN THAN B TO SHOW RESULTS. This takes the value - 1 character (sicne the last character is a .
        End If

        i = i + 1
    Next

我添加了结果屏幕

在此处输入图片描述

答案2

  1. 转到数据 - 文本到列
  2. 根据划定\
  3. 然后你可以使用如下公式=LEFT(A2,1)&"."&LEFT(B2,1)&"."&LEFT(C2,1)

VBA-假设您的数据在 A 列

Sub Search_DelimitedSubString_In_String()
Application.ScreenUpdating = False
Dim strFolder As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
j = 1
'Loop through cells
For Each c In Range("A:A")
    'Select non-blanks
    If c.Value <> "" Then
        On Error Resume Next
        For i = 1 To Len(c.Value)
            If Mid(c.Value, i, 1) = "\" Then
                If IsNumeric(Mid(c.Value, i + 1, 1)) Then
                strFolder = strFolder & Mid(c.Value, i + 1, 1) & "."
                End If
            End If

        Next

    Cells(j, 2) = strFolder
    j = j + 1
    End If
 strFolder = ""
 Next c

 For Each c In Range("B:B")
 If c.Value <> "" Then
    k = Len(c.Value)
    c.Value = Left(c.Value, k - 1)
 End If
 Next

Application.ScreenUpdating = True
End Sub

答案3

假设所有数据都在 A 列中，则 B 列将如下所示：

在此处输入图片描述

Dim RE As Object
Set RE = CreateObject("VBScript.RegExp")
RE.Global = True
RE.Pattern = "\\(\d+)"

For Each c In UsedRange.Columns(1).Cells
    Set matches = RE.Execute(c)
    ReDim all(matches.Count - 1)
    For i = 0 To matches.Count - 1
        all(i) = matches.Item(i).Submatches(0)
    Next
    c.Offset(0, 1) = Join(all(), ".")
Next

我使用了 VBA Regex、两个循环和一个数组 Join

VBA 正则表达式不支持后视否则您可以使用(?<=\\)\d+。

答案4

如果“Folder”确实是“Folder”（而不是特殊文件夹名称的常用名称），则此公式将最快。将其输入到 B1 中并向下拖动或双击填充加号：

=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"_Folder\","."),"c:\",""),"_Folder","")

相关内容