|
-
Jul 8th, 2012, 04:10 PM
#1
Thread Starter
New Member
[RESOLVED] evaluate and note/save array duplicates
Hi, I have 4 arrays one holding which items in another array were duplicates, with those indexes I have other arrays to index, coordinates and values. Some of the coordinates are equal, so I have to take the coordinate with the highest value and drop the other one (or two, or three, etc). I am having a really tough time with this, which I thought would be easy. Any ideas will be VERY appreciated! 
Code:
Sub testLogic()
Dim index(13) As Variant
Dim coord(13) As Variant
Dim dups(13) As Variant
Dim tVAL(13) As Variant
Dim i As Long
Dim rIndex() As Variant
Dim rCoord() As Variant
Dim rDups() As Variant
Dim rtVal() As Variant
index(0) = "0"
index(1) = "1"
index(2) = "2"
index(3) = "3"
index(4) = "4"
index(5) = "5"
index(6) = "6"
index(7) = "7"
index(8) = "8"
index(9) = "9"
index(10) = "10"
index(11) = "11"
index(12) = "12"
index(13) = "13"
coord(0) = "1,57"
coord(1) = "1,57"
coord(2) = "1,57"
coord(3) = "1,58"
coord(4) = "1,59"
coord(5) = "1,60"
coord(6) = "1,61"
coord(7) = "1,61"
coord(8) = "1,62"
coord(9) = "1,63"
coord(10) = "1,64"
coord(11) = "1,65"
coord(12) = "1,65"
coord(13) = "1,65"
dups(0) = "x"
dups(1) = "x"
dups(2) = "x"
dups(3) = ""
dups(4) = ""
dups(5) = ""
dups(6) = "x"
dups(7) = "x"
dups(8) = ""
dups(9) = ""
dups(10) = ""
dups(11) = "x"
dups(12) = "x"
dups(13) = "x"
tVAL(0) = "5"
tVAL(1) = "5"
tVAL(2) = "4.5"
tVAL(3) = "5"
tVAL(4) = "5"
tVAL(5) = "5"
tVAL(6) = "3"
tVAL(7) = "4.5"
tVAL(8) = "5"
tVAL(9) = "5"
tVAL(10) = "4.5"
tVAL(11) = "3.4"
tVAL(12) = "5"
tVAL(13) = "5"
For i = 0 To UBound(dups) ' LOOP THROUGH TO SAVE A SUBSET OF DUPS STORED IN rDups
If dups(i) = "x" Then
If IsBounded(rDups) Then
ReDim Preserve rDups(0 To UBound(rDups) + 1)
rDups(UBound(rDups)) = i
Else
ReDim Preserve rDups(0)
rDups(0) = i
End If
End If
Next i
For i = 0 To UBound(rDups) ' LOOP THROUGH DUPS TO GET ALL DUP COORDS STORED IN rCoord
If IsBounded(rCoord) Then
ReDim Preserve rCoord(0 To UBound(rCoord) + 1)
rCoord(UBound(rCoord)) = coord(CLng(rDups(i)))
Else
ReDim Preserve rCoord(0)
rCoord(0) = coord(CLng(rDups(i)))
End If
Next i
For i = 0 To UBound(rDups) ' LOOP THROUGH DUPS TO GET ALL DUP'S tVALS STORED IN rtVAL
If IsBounded(rtVal) Then
ReDim Preserve rtVal(0 To UBound(rtVal) + 1)
rtVal(UBound(rtVal)) = tVAL(CLng(rDups(i)))
Else
ReDim Preserve rtVal(0)
rtVal(0) = tVAL(CLng(rDups(i)))
End If
Next i
' NOW WALK THROUGH COORDINATES rCoord AND FOR EVERY COORD THAT IS EQUAL, STORE THE INDEX NUMBER OF THE ONE WITH THE HIGHER rtVAL
' EITHER ONE IF THEY ARE THE SAME, SO FROM THE DATA ABOVE I SHOULD BE STORING THESE INDEX VALUES:
' 0 (or 1)
' 7
' 12 (or 13)
End Sub
-
Jul 9th, 2012, 05:18 AM
#2
Thread Starter
New Member
Re: evaluate and note/save array duplicates
I figured it out. You know I had sorted the data by the X and Y coordinates, to group the duplicates, prior to running everything, but it never occurred to me to add a level to the sort and then sort by values descending! Then all I had to do was step through in my code and grab the first or each group. That way I get one even if they're the same AND the first one is also always going to be the highest!
D-UH! I can't believe I spent so many hours trying to figure out how to look ahead and behind an indeterminate number of members, testing and re-saving in other variables, etc. Man my code was becoming more of a mess than usual! Here's the mess of a function I ended up using, which did the trick:
vb Code:
Function markDupsForRemoval(index() As Variant, coord() As Variant, dups() As Variant, daq() As Variant) As Variant ' RETURNS A LIST OF INDEXES/ROWS TO BE SAVED Dim i As Long Dim j As Long Dim n As Long Dim resIndex() As Variant Dim resDups() As Variant Dim resCoords() As Variant Dim resDAQ() As Variant For i = 0 To UBound(index) ' LOOP THROUGH TO SAVE A SUBSET OF DUPS If dups(i) = "x" Then If IsBounded(resDups) Then ReDim Preserve resDups(0 To UBound(resDups) + 1) resDups(UBound(resDups)) = i Else ReDim Preserve resDups(0) resDups(0) = i End If End If Next i 'For i = 0 To UBound(resDups) ' MsgBox "resDup " & i & " = " & resDups(i) 'Next i For i = 0 To UBound(resDups) ' LOOP THROUGH DUPS TO GET ALL DUP COORDS If IsBounded(resCoords) Then ReDim Preserve resCoords(0 To UBound(resCoords) + 1) resCoords(UBound(resCoords)) = coord(CLng(resDups(i))) Else ReDim Preserve resCoords(0) resCoords(0) = coord(CLng(resDups(i))) End If Next i For i = 0 To UBound(resDups) ' LOOP THROUGH DUPS TO GET ALL DUP'S DAQS If IsBounded(resDAQ) Then ReDim Preserve resDAQ(0 To UBound(resDAQ) + 1) resDAQ(UBound(resDAQ)) = daq(CLng(resDups(i))) Else ReDim Preserve resDAQ(0) resDAQ(0) = daq(CLng(resDups(i))) End If Next i Dim arrHI() As Variant Dim jlast As Long Dim ckCoord As Variant Dim bIn As Boolean j = 0 bIn = False ckCoord = resCoords(0) For i = 0 To UBound(resCoords) ' LOOP THROUGH DUPS TO GET ALL DUP'S DAQS If resCoords(i) = ckCoord Then ' SAME COORD GRAB FIRST DAQ VALUE INDEX, SINCE SORTED DESCENDING If j = 0 Then If Not bIn Then ReDim Preserve arrHI(j) arrHI(j) = resDups(i) j = j + 1 bIn = True End If Else If Not bIn Then ReDim Preserve arrHI(0 To UBound(arrHI) + 1) arrHI(j) = resDups(i - 1) j = j + 1 bIn = True End If End If Else ' DIFFERENT COORDS UPDATE CHECK VALUE ckCoord = resCoords(i) bIn = False End If Next i For i = LBound(index) To UBound(index) Next i markDupsForRemoval = arrHI Erase resDups Erase resCoords Erase resDAQ End Function
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|