[英]VBA excel Loop through 2 arrays together
I am filling two arrays with values one for inclusion and the other for exclusion. 我用值填充两个数组,一个用于包含,另一个用于排除。 All working to this point. 所有工作到这一点。 The next part should take the values from each array and replace unwanted values with a blank space. 下一部分应获取每个数组中的值,并用空格替换不需要的值。 This also works but only for the first value. 这也适用,但仅适用于第一个值。 I know i need a loop here but can't get my head around it. 我知道我需要在这里循环,但无法绕开它。 Any pointers would be helpful. 任何指针都会有所帮助。 If there is a better way, I'm all ears. 如果有更好的方法,我会全力以赴。
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
Adding this sub and replacing the section that is not working with a call to the sub should work. 添加该子并替换不适合该子调用的部分。
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
You can call it this way: RemoveUnwantedValues result, del
您可以这样称呼: RemoveUnwantedValues result, del
Thanks for your help. 谢谢你的帮助。 It turns out i was over complicating things. 事实证明,我已经使事情复杂化了。 All i ended up needing to do was remove the join on result remove loop iii and place If instr, del & ServiceSym inside of loop ii. 我最后要做的就是删除结果删除循环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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.