Home > Back-end >  Take in columns the coordinates X,Y of a rectangular grid with specific step size
Take in columns the coordinates X,Y of a rectangular grid with specific step size

Time:09-28

I would like to create in excel using VBA two columns containing all possible pairs of X and Y-coordinates starting from point (0,0) to (20,20) with step size five, as the attached figure depicts

enter image description here

I am at the elementary level in VBA, and unfortunately, I didn't have too much success.

I would appreciate any help.

CodePudding user response:

The idea is to have a nested loop, one for x and inside that another one for y using defined steps.

Option Explicit

Public Sub CreateValuePairs()

    Dim x As Long
    For x = 0 To 20 Step 5
    
        Dim y As Long
        For y = 0 To 20 Step 5
            Debug.Print x, y  ' output into immediate window
        Next y
        
    Next x
    
End Sub

The output in the immediate window then is

 0             0 
 0             5 
 0             10 
 0             15 
 0             20 
 5             0 
 5             5 
 5             10 
 5             15 
 5             20 
 10            0 
 10            5 
 10            10 
 10            15 
 10            20 
 15            0 
 15            5 
 15            10 
 15            15 
 15            20 
 20            0 
 20            5 
 20            10 
 20            15 
 20            20 

Alternatively you better write a generic function to generate value tables and then write them to your cells.

Public Sub Example()
    ' generate values
    Dim ValTable As Variant
    ValTable = GetValuePairs(FromValue:=0, ToValue:=20, Steps:=5)
    
    ' write to cells
    Range("A1").Resize(UBound(ValTable, 1), UBound(ValTable, 2)).Value = ValTable
End Sub

Public Function GetValuePairs(ByVal FromValue As Long, ByVal ToValue As Long, ByVal Steps As Long) As Variant
    Dim AmountOfPairs As Long  ' amount of pairs we need to create
    AmountOfPairs = ((ToValue - FromValue) / Steps   1) ^ 2
    
    ' create 2 dimensional output array
    Dim Output() As Long
    ReDim Output(1 To AmountOfPairs, 1 To 2)
    
    ' create pairs
    Dim iPair As Long
    For iPair = 1 To AmountOfPairs
        Dim x As Long
        x = FromValue   ((iPair - 1) \ Sqr(AmountOfPairs)) * Steps
        
        Dim y As Long
        y = FromValue   ((iPair - 1) Mod Sqr(AmountOfPairs)) * Steps
        
        Output(iPair, 1) = x
        Output(iPair, 2) = y
    Next iPair
    
    ' return array
    GetValuePairs = Output
End Function

CodePudding user response:

enter image description here Finally, I think i what i had in my mind works

Sub XY()
Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long, G As Long, N As Long, i As Long, j As Long

'
'Fill in X-axis column
'
With ActiveSheet
N = .Cells(Rows.Count, "D").End(xlUp).Row
A = ActiveSheet.Range("B1").Value
B = ActiveSheet.Range("B3").Value
C = ActiveSheet.Range("B4").Value
D = ActiveSheet.Range("B5").Value
N = 2
For i = 1 To C Step 1
For j = A To B Step D
.Cells(N, "D").Value = j
N = N   1
Next j
Next i
End With
'
'Fill in Y-axis column
'
With ActiveSheet
N = .Cells(Rows.Count, "E").End(xlUp).Row
A = ActiveSheet.Range("B1").Value
E = ActiveSheet.Range("B7").Value
F = ActiveSheet.Range("B8").Value
G = ActiveSheet.Range("B9").Value
N = 2
For i = A To E Step G
For j = 1 To F Step 1
.Cells(N, "E").Value = i
N = N   1
Next j
Next i
End With
End Sub
  • Related