PDA

View Full Version : [SOLVED] Crossovers



jmnpinheiro
09-02-2014, 06:48 PM
Hi fellows,

I'm struggling with the code to solve this:

I have 2 datasets in columns a b c and e f g. Here's a sample (more than 7000 registers each dataset)

dataset A-85358,112 -105068,934 9,077
-85358,467 -105068,634 9,077
-85358,825 -105068,333 9,077
-85359,172 -105068,037 9,057
-85359,486 -105067,757 9,027
dataset B
-85121,817 -104640,206 8,013
-85121,990 -104640,531 8,053
-85122,160 -104640,850 8,093
-85122,333 -104641,174 8,113
-85122,505 -104641,496 8,103

I need a routine that loops through each register on dataset A and test it with each register on dataset B (a register has 3 coordinates X, Y, Z)
- read dataset A line 1 col a , b , c and keep values in variables AX1, AY1, AZ1
- read dataset B line 1 col e, f, g and keep values in variables BX1, BY1, BZ1
- test a condition: if sqrt((AX1-BX1)^2+(AY1-BY1)^2)<0.1
condition is met...then
- write the average (AX1+BX1)/2 to col i
- write the average (AY1+BY1)/2 to col j
- write the difference abs(AZ1-BZ1) to col k
- else... it must test again using next value on dataset 2 (on line 2)...and so on
- after testing AX1, AY1,AZ1 with all BXn,BYn,BZn jump to next register on dataset 1 AX2, AY2, AZ2 an repeat the process

- the new values must fill new rows in I, J, K columns
- as the source generates variable dataset dimensions, it should identify an emty row as a stop loop criteria

Maybe I'm asking too much..but I bealive it could be simple for most of you.

Thank You All


































165


105067,153

SamT
09-02-2014, 09:43 PM
It's just a nested loop with a provision to jump out of the inner loop if a condition is met. I added a provision for if the condition is never met.

Neither compiled nor tested.

Sub SamT()
Const colA As Long = 1
Const colB As Long = 2
Const colC As Long = 3
Const colE As long = 5
Const colF As Long = 6
Const colG As Long = 7
Const colI As Long = 9
Const colJ As long = 10
Const colk As Long = 11

LastARow = Cells(Rows.Count, 1).End(xlUp).Row
LastBRow = Cells(rows.Count, 5).End(xlUp).Row

For A = 1 to LastARow
For B = 1 to LastBRow
If Sqrt((Cells(A, colA) - Cells(B, colE))^2 + (Cells(A, colB) - Cells(B, colF))^2) < 0.1 Then 'Condition is met
Cells(A, colI) = (Cells(A, colA) - Cells(B colE))/2
Cells(A, colJ) = (Cells(A, colB) - Cells(B, colF))/2
Cells(A, colK) = Abs(Cells(A, colC) - Cells(B, colG))
GoTo ConditionMet
End If
Next B

If B = LastBRow then Cells(A, colI) = "Condition Not Met"

ConditionMet
Next A
End Sub
You can change the constant names to AX1, AX2, etc, if you want. This was easier for me to understand. While you're at it, change Variables A and B to ARow and BRow so they make more sense, too.

Bob Phillips
09-03-2014, 12:33 AM
Very difficult to test as none of your values seem to meet the criteria, but you could try these formulae.

In L1, add this array formula =MIN(IF(SQRT(($A$1:$A$5-$E$1:$E$5)^2+($B$1:$B$5-$F$1:$F$5)^2)<0.1,ROW($A$1:$A$5)))
I1: =IF($L1>0,$A1+INDEX(E$1:E$5,$L1),"")
J1: =IF($L1>0,$A1+INDEX(F$1:F$5,$L1),"")
K1: =IF($L1>0,ABS($A1-INDEX(G$1:G$5,$L1)),"")

and copy down.

snb
09-03-2014, 02:14 AM
to do all the calculations in memory:


Sub M_snb()
y1= cells(1,1).currentregion.rows.count
y2=cells(1,5).currentregion.rows.count

sn=cells(1).currentregion.resize(application.max(y1,y2),11)

for j=1 to y1
for jj=1 to y2
if Sqrt((sn(j,1) - sn(j,4))^2 + (sn(j,2)-sn(j,6))^2) < 0.1 Then
sn(j,9)=(sn(j,1) - sn(j,4))/2
sn(j,10)=(sn(j,2)-sn(j,6))/2
sn(j,11)=sn(j,3)-sn(j,4)
exit for
end if
next
next

sheet2.cells(1).resize(ubound(sn),ubound(sn,2))=sn
End Sub

jmnpinheiro
09-03-2014, 09:18 AM
Hi XLD,

followed your instructions, replaced the commas (we use ; instead) and drag down the formulas.

I'll send you the file...maybe I'm doing omething wrong...

Thank You very much for your time

Bob Phillips
09-03-2014, 02:18 PM
You need to array-enter the formula in column L, ctrl-shift-enter not just enter. But they are all coming out as 0.

jmnpinheiro
09-04-2014, 08:40 AM
xld,

I was missing the ctrl+shift-enter comand...although, still returning "zeros" like you told me..
I know for shore that at least 50 registers must meet the condition..maybe for a value greater then 0.1 ....but I even tried with 0.9 (meters) an still nothing..don't get it.
If rounded to units, a simple access query returns hundreds of matches..but it's not practical at all.
I'll keep digging this valuable information that you have shared with me.

Thank You
JP

Bob Phillips
09-04-2014, 08:45 AM
Can you tell me an example of one that should match?

jmnpinheiro
09-04-2014, 09:13 AM
Hi SamT

debugging shows me "sub or function not defined" for "ConditionMet"...
I'm sending you the original file, maybe you could test it.

Thank You
JP

jmnpinheiro
09-04-2014, 09:46 AM
snb,

the code runs whithout any messages but it doesn't return any values as expected..even when using higher values in the condition.
I also don't know if the decimal separator (comma in exel and dot in vba) can lead to any kind of ambiguities.
I'm sending you the file maybe you can figure it out.

JP

snb
09-04-2014, 10:07 AM
The code doesn't run without messages; it contains a typo.
Amend the code.
Check the sheetnames & run it.

SamT
09-04-2014, 11:24 AM
maybe for a value greater then 0.1
The condition to be met in all the code and formulas above is that of LESS THAN 0.01

Change that line to be either ">=" or ">"

SamT
09-04-2014, 11:29 AM
There is no code in that workbook Just 374 KB of data.

jmnpinheiro
09-04-2014, 11:32 AM
xld,

dataset A line 604 (col a b c) -85418,229 -104991,087 8,022
dataset B line 923 (col e f g) -85418,954 -104991,219 7,988
raising the conditon to < 0,8 it should be detected, since SQRT((x1-x2)^2)+(y1-2)^2 = 0,742

I'll try to send you a bigger list of crossovers if needed..I thing some of them will match closer that this

JP

SamT
09-04-2014, 11:52 AM
@snb
The code doesn't run without messages; it contains a typo. Thanks, that made me take a closer look at my own code. This time in the VBE.

Here is my original code Refactored into using your chosen variable names. I found a missing comma and a missing colon and repaired them. It checks for the condition "equal to or greater than 0.01"

Sub SamT()
Const AX1 As Long = 1 'Column Numbers of values used in formulas
Const AY1 As Long = 2
Const AZ1 As Long = 3
Const BX1 As Long = 5
Const BY1 As Long = 6
Const BZ1 As Long = 7
Const avgX As Long = 9
Const avgY As Long = 10
Const DiffZ As Long = 11

Dim LastARow As Long
Dim LastBRow As Long

LastARow = Cells(Rows.Count, AX1).End(xlUp).Row
LastBRow = Cells(Rows.Count, BX1).End(xlUp).Row

For ARow = 1 To LastARow
For BRow = 1 To LastBRow
If Sqrt((Cells(ARow, AX1) - Cells(BRow, BX1)) ^ 2 _
+ (Cells(ARow, AY1) - Cells(BRow, BY1)) ^ 2) _
>= 0.1 Then 'Condition is met
Cells(ARow, avgX) = (Cells(ARow, AX1) - Cells(BRow, BX1)) / 2
Cells(ARow, avgY) = (Cells(ARow, AY1) - Cells(BRow, BY1)) / 2
Cells(ARow, DiffZ) = Abs(Cells(ARow, AZ1) - Cells(BRow, BZ1))
GoTo ConditionMet
End If
Next BRow

If BRow = LastBRow Then Cells(ARow, avgX) = "Condition Not Met"

ConditionMet:
Next ARow
End Sub

Bob Phillips
09-04-2014, 03:38 PM
xld,

dataset A line 604 (col a b c) -85418,229 -104991,087 8,022
dataset B line 923 (col e f g) -85418,954 -104991,219 7,988
raising the conditon to < 0,8 it should be detected, since SQRT((x1-x2)^2)+(y1-2)^2 = 0,742

I'll try to send you a bigger list of crossovers if needed..I thing some of them will match closer that this

JP

Sorry, this thread is getting far too noisy, so I will bow out.

jmnpinheiro
09-05-2014, 04:21 AM
Hi SamT,

it has been a pleasure learning with You. Your code does exactly what was supposed to. I had to introduce some minor changes:
1) + sign on averages (instead of -)
2) make the condition minor equal to (not greater equal than) so, if the distance between two points it's smaller than the condition (0.1 to 0.5) it means that they both stand at a crossover region
3) SQR (instead of SQRT)

It took about 7 minutes to test almost 28 000 000 times the condition and returned 200 registers (test condition <= 0.5)
I cleaned the blank rows, imported to Cad3D and IT'S DONE;)

Thank You very much for you time!

JP

SamT
09-05-2014, 07:08 AM
:thumb