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