这是一个循环遍历范围的 VBA 方法,本质上是用蛮力进行评估。
我相信它可以被清理并提高效率。应该让你开始。
Sub NodeList()
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets("Sheet1")
'First Column
Dim rngA As Range
Set rngA = [A2:A10]
Dim datA As Variant
datA = rngA
Dim i As Long
Dim j As Long
'Results
Dim myarray()
ReDim myarray(100, 100)
Dim datR As Variant
Dim store As Boolean
Dim duplicate As Boolean
store = False
duplicate = False
Dim cntr As Integer
cntr = 0
'Range Column loop
For i = LBound(datA, 1) To UBound(datA, 1)
'Find first result
If IsEmpty(myarray(0, 0)) Then
'Is Col E valid?
If Not IsError(rngA(i, 5)) Then
If rngA(i, 5) <> 0 Or rngA(i, 5) <> "#N/A" Or Not IsEmpty(rngA(i, 5)) Then
'Col E is valid
store = True
col = 5
End If
End If
'Is Col F valid?
If store = False And Not IsError(rngA(i, 6)) Then
If rngA(i, 6) <> 0 Or rngA(i, 6) <> "#N/A" Or Not IsEmpty(rngA(i, 6)) Then
'Col E is valid
store = True
col = 6
End If
End If
'Store value to results
If store = True Then
myarray(0, 0) = rngA(i, 1)
myarray(0, 1) = rngA(i, col)
store = False
End If
Else
'Results has at least one value check for duplicate
'Loop thru results
For k = LBound(myarray) To UBound(myarray)
If datA(i, 1) = myarray(k, 0) Then
' duplicate found
duplicate = True
Exit For
End If
Next
If duplicate = False Then
'validate data
If Not IsError(rngA(i, 5)) Then
If rngA(i, 5) <> 0 Or rngA(i, 5) <> "#N/A" Or Not IsEmpty(rngA(i, 5)) Then
'Col E is valid
store = True
col = 5
End If
End If
'Is Col F valid?
If store = False And Not IsError(rngA(i, 6)) Then
If rngA(i, 6) <> 0 Or rngA(i, 6) <> "#N/A" Or Not IsEmpty(rngA(i, 6)) Then
'Col E is valid
store = True
col = 6
End If
End If
'Store value to results
If store = True Then
cntr = cntr + 1
myarray(cntr, 0) = rngA(i, 1)
myarray(cntr, 1) = rngA(i, col)
store = False
End If
End If
duplicate = False
End If
Next
Dim rngB As Range
Set rngB = [B2:B10]
datA = rngB
'Range Column loop
For i = LBound(datA, 1) To UBound(datA, 1)
'Find first result
If IsEmpty(myarray(0, 0)) Then
'Is Col E valid?
If Not IsError(rngA(i, 5)) Then
If rngA(i, 5) <> 0 Or rngA(i, 5) <> "#N/A" Or Not IsEmpty(rngA(i, 5)) Then
'Col E is valid
store = True
col = 5
End If
End If
'Is Col F valid?
If store = False And Not IsError(rngA(i, 6)) Then
If rngA(i, 6) <> 0 Or rngA(i, 6) <> "#N/A" Or Not IsEmpty(rngA(i, 6)) Then
'Col E is valid
store = True
col = 6
End If
End If
'Store value to results
If store = True Then
myarray(0, 0) = rngA(i, 2)
myarray(0, 1) = rngA(i, col)
store = False
End If
Else
'Results has at least one value check for duplicate
'Loop thru results
For k = LBound(myarray) To UBound(myarray)
If datA(i, 1) = myarray(k, 0) Then
' duplicate found
duplicate = True
Exit For
End If
Next
If duplicate = False Then
'validate data
If Not IsError(rngA(i, 5)) Then
If rngA(i, 5) <> 0 Or rngA(i, 5) <> "#N/A" Or Not IsEmpty(rngA(i, 5)) Then
'Col E is valid
store = True
col = 5
End If
End If
'Is Col F valid?
If store = False And Not IsError(rngA(i, 6)) Then
If rngA(i, 6) <> 0 Or rngA(i, 6) <> "#N/A" Or Not IsEmpty(rngA(i, 6)) Then
'Col E is valid
store = True
col = 6
End If
End If
If store = False Then
'Both are invalid
'look in col 'A' and reloop thru value to find another match
For p = LBound(myarray) To UBound(myarray)
If rngA(i, 1) = myarray(p, 0) Then
cntr = cntr + 1
myarray(cntr, 0) = rngA(i, 2)
myarray(cntr, 1) = myarray(p, 1)
store = False
Exit For
End If
Next
End If
'Store value to results
If store = True Then
cntr = cntr + 1
myarray(cntr, 0) = rngA(i, 2)
myarray(cntr, 1) = rngA(i, col)
store = False
End If
End If
duplicate = False
End If
Next
For i = LBound(myarray) To UBound(myarray)
Range("H" & i + 1).Value = myarray(i, 0)
Range("I" & i + 1).Value = myarray(i, 1)
Next
End Sub
输出如下所示:
我没有添加名称,但您可以通过修改数组来做到这一点。