时间戳

首页 > 解决方案 > For Each 嵌套在另一个 For Each 不完全工作

excel - For Each 嵌套在另一个 For Each 不完全工作

问题描述

我写了一些 VBA 代码来做几件事：1）。检索 3 个范围：字符串范围、输出范围、子字符串（查找）范围 2）。循环遍历字符串范围以查找子字符串列表 3)。将发现的子字符串添加到输出范围

我的代码只会对子字符串范围内的第一个单元格执行这些操作。我不允许嵌套 For Each 循环吗？

Sub ExtrSubString()

    Dim sRg As Range
    Dim sDRg As Range
    Dim sRRg As Range
    Dim sFRg As Range
    Dim ssF1Rg As Range

    Dim cCellLength As Integer
    Dim cFindLength As Integer
    Dim cNumber As Integer

    Dim strList As String
    Dim sTitleId As String

    Dim nI As Integer

    sTitleId = "Substring Extraction"
    Set sDRg = Application.InputBox("Please select text strings:", xTitleId, "", Type:=8)
    If TypeName(sDRg) = "Nothing" Then Exit Sub

    Set sRRg = Application.InputBox("Please select output cell:", xTitleId, "", Type:=8)
    If TypeName(sRRg) = "Nothing" Then Exit Sub

    Set sFRg = Application.InputBox("Please select substring cell:", xTitleId, "", Type:=8)
    If TypeName(sFRg) = "Nothing" Then Exit Sub

    sI = 0
    strNumber = ""


    For Each sRg In sDRg
        nI = nI + 1

            For Each ssF1Rg In sFRg

                cCellLength = Len(sRg)
                cFindLength = Len(ssF1Rg)

                For cNumber = 1 To cCellLength
                    If ssF1Rg = (Mid(sRg, cNumber, cFindLength)) Then
                        strList = (Mid(sRg, cNumber, cFindLength))
                    End If
                Next cNumber

            Next ssF1Rg

        sRRg.Item(nI) = strList
        strList = ""

    Next sRg

End Sub

标签： excelvbaforeachsubstringmatch

解决方案

您的问题的技术答案：是的，您可以在 loops 内运行循环，但是我意识到您的最终问题是“为什么它不做我想要的？！？”。我不确定这个问题的答案，因为我不明白你的意图。我在即时窗口中添加了一些断点和一些打印，以证明它正在运行循环。我还清理了几个部分。如果你在你正在处理的任何事情上运行它，你可能会找出你的问题。

Sub ExtrSubString()
Const turnOnBreakpoints As Boolean = True 'set this to false to run fully through code

    Dim sRg As Range, sDRg As Range, sRRg As Range, sFRg As Range, ssF1Rg As Range

    Dim cCellLength As Long, cFindLength As Long, cNumber As Long, ni As Long
    Dim strList As String

    Const stitleid As String = "Substring Extraction" 'not doing anything

    Set sDRg = Application.InputBox("Please select text strings:", xTitleId, "", Type:=8)
        If sDRg Is Nothing Then Exit Sub 'cleaner test for nothing

    Set sRRg = Application.InputBox("Please select output cell:", xTitleId, "", Type:=8)
        If sRRg Is Nothing Then Exit Sub

    Set sFRg = Application.InputBox("Please select substring cell:", xTitleId, "", Type:=8)
        If sFRg Is Nothing Then Exit Sub

    'these aren't doing anything
    'sI = 0
    'strNumber = ""

    For Each sRg In sDRg.Cells
        ni = ni + 1

            For Each ssF1Rg In sFRg.Cells
                Dim loopssF1rg As Long 'used to count the loops for illustration

                cCellLength = Len(sRg)
                cFindLength = Len(ssF1Rg)

                For cNumber = 1 To cCellLength

                    'you're trying to capture part of string here and do what?
                    If ssF1Rg = (Mid(sRg.Value, cNumber, cFindLength)) Then
                        strList = (Mid(sRg.Value, cNumber, cFindLength))
                    End If
                    Debug.Print "loop Cnumber run " & cNumber
                    If turnOnBreakpoints Then Stop
                Next cNumber

                loopssF1rg = loopssF1rg + 1
                If turnOnBreakpoints Then Stop
                Debug.Print "loopssF1rg run " & loopssF1rg
            Next ssF1Rg

        'what is the intent here?
        sRRg.Item(ni) = strList
        strList = ""
    Debug.Print "srg loop run " & ni
    Next sRg

End Sub

推荐阅读