VBA excel一起循环遍历2个数组

Question

我用值填充两个数组，一个用于包含，另一个用于排除。 所有工作到这一点。 下一部分应获取每个数组中的值，并用空格替换不需要的值。 这也适用，但仅适用于第一个值。 我知道我需要在这里循环，但无法绕开它。 任何指针都会有所帮助。 如果有更好的方法，我会全力以赴。

---

Sub Service_Symbols()

Application.ScreenUpdating = False
Dim StringArray() As String

Dim i As Long
Dim ii As Long
Dim iii As Long

For i = Sheet2.Cells(Rows.Count, 11).End(xlUp).Row To 2 Step -1
    'Seperate multiple values in cells
    If InStr(Cells(i, 11).Value, ",") <> 0 Then
        StringArray() = Split(Cells(i, 11).Value, ",")
        'Place selected values into array for inclusion
        For ii = LBound(StringArray) To UBound(StringArray)
            If IsInArray(StringArray(), "1") Or IsInArray(StringArray, "4") Or IsInArray(StringArray, "5") Or IsInArray(StringArray, "6") Or IsInArray(StringArray, "7") Or IsInArray(StringArray, "8") Then
                result = Join(StringArray(), " ")
            End If
        Next ii
        'Place selected values into array for removal
        For iii = LBound(StringArray) To UBound(StringArray)
            ResultDel = StringArray(iii)
            If InStr(ResultDel, "2") <> 0 Or InStr(ResultDel, "3") <> 0 Or InStr(ResultDel, "9") <> 0 Or InStr(ResultDel, "11") <> 0 Then
            del = ResultDel
            Debug.Print i; ResultDel
            End If
        Next iii

        'This section not working. Needs to be looped

        'Remove unwanted values
        ServiceSym = Trim(Replace(Replace(Replace(result, del, ""), del, ""), "  ", " "))
        ServiceSym = Replace(ServiceSym, " ", ",")
        'Sheet1.Range("G" & i).Value = ServiceSym
        Debug.Print i; ServiceSym
        'Debug.Print result
        'Debug.Print i; del

        'End of this section not working. Needs to be looped

    'transfer selected single values in cells
    ElseIf Sheet2.Range("K" & i).Value = "1" Or Sheet2.Range("K" & i).Value = "4" Or Sheet2.Range("K" & i).Value = "5" Or Sheet2.Range("K" & i).Value = "6" Or Sheet2.Range("K" & i).Value = "7" Or Sheet2.Range("K" & i).Value = "8" Then
    result2 = Sheet2.Range("K" & i).Value
    'Sheet1.Range("G" & i).Value = result2
    Debug.Print i; result2
    End If
Next i

Application.ScreenUpdating = True

'Call More_Services_Symbols 'Run the more services sub

End Sub

Answer 1

添加该子并替换不适合该子调用的部分。

Sub RemoveUnwantedValues(ByRef result As String, del)

    Dim i           As Integer
    Dim arrResult() As String


    arrResult = Split(result, " ")

    For i = LBound(arrResult) To UBound(arrResult)
        arrResult(i) = Trim(Replace(Replace(Replace(arrResult(i), del, ""), del, ""), "  ", " "))
        arrResult(i) = Replace(arrResult(i), " ", ",")
    Next i

End Sub

您可以这样称呼： RemoveUnwantedValues result, del

Answer 2

谢谢你的帮助。 事实证明，我已经使事情复杂化了。 我最后要做的就是删除结果删除循环iii上的联接，并将If instr，del＆ServiceSym放在循环ii内。

Sub Service_Symbols()

Application.ScreenUpdating = False
Dim StringArray() As String

Dim i As Long

For i = Sheet2.Cells(Rows.Count, 11).End(xlUp).Row To 2 Step -1
'Seperate multiple values in cells
If InStr(Cells(i, 11).Value, ",") <> 0 Then
    StringArray() = Split(Cells(i, 11).Value, ",")
    'Place selected values into array for inclusion
    For ii = LBound(StringArray) To UBound(StringArray)
        If IsInArray(StringArray(), "1") Or IsInArray(StringArray, "4") Or IsInArray(StringArray, "5") Or IsInArray(StringArray, "6") Or IsInArray(StringArray, "7") Or IsInArray(StringArray, "8") Then
            result = StringArray(ii)
            'Debug.Print i; result
        End If
        If InStr(result, "2") <> 0 Or InStr(result, "3") <> 0 Or InStr(result, "9") <> 0 Or InStr(result, "11") <> 0 Then
            del = result
            'Debug.Print i; "del-"; del
        End If
    ServiceSym = Replace(result, del, "")
    'Sheet1.Range("G" & i).Value = ServiceSym
    Debug.Print i; ServiceSym

    Next ii

'transfer selected single values in cells
ElseIf Sheet2.Range("K" & i).Value = "1" Or Sheet2.Range("K" & i).Value = "4" Or Sheet2.Range("K" & i).Value = "5" Or Sheet2.Range("K" & i).Value = "6" Or Sheet2.Range("K" & i).Value = "7" Or Sheet2.Range("K" & i).Value = "8" Then
result2 = Sheet2.Range("K" & i).Value
'Sheet1.Range("G" & i).Value = result2
Debug.Print i; result2
End If
Next i

Application.ScreenUpdating = True

'Call More_Services_Symbols 'Run the more services sub

End Sub