How can I create a loop that only reads every 2 cells in the range?-CodePudding

I am trying to create a loop that will run through a set of data where each row is an ID and an amount. The columns are structured in pairs, where the first one is a destination and the second is a percentage.

I need to create one row for each destination, give it it's ID and then multiply the amount by each of the multipliers. I have no clue as to how to select the different multipliers since there is two types of info in the same dimension of the array.

Here is an example data set:

And this is what I need to create:

As you can see, each pair of destination multiplier columns needs to get its own row.

EDIT: This is the code I have so far:

'1. Definiendo el archivo de repositorio

    Dim repositorio_counter     As Integer
    repositorio_counter = file_count("C:\Users\02775422\Desktop\archive\nominas\repositorio.xlsx")
    
    Dim repositorio_wb As Workbook
    Dim repositorio_path As Variant
    
    If repositorio_counter = 1 Then
        Set repositorio_wb = Workbooks.Open(Filename:="C:\Users\02775422\Desktop\archive\nominas\repositorio.xlsx")
    ElseIf repositorio_counter = 0 Then
        MsgBox ("El repositorio de nóminas no se encuentra su ubicación predeterminada: C:\Users\02775422\Desktop\archive\nominas\repositorio.xlsx")
        ChDir "C:\Users\02775422\Desktop"
        repositorio_path = Application.GetOpenFilename(Title:="Seleccione el repositorio de nóminas:")
        If repositorio_path = False Then
            MsgBox ("La macro ha sido terminada. Si desea iniciarla de nuevo seleccione el repositorio de nóminas o deposítelo en su ubicación predeterminada: C:\Users\[user]\Desktop\archive\nominas\repositorioo.xlsx")
            Exit Sub
        Else
            Set repositorio_wb = Workbooks.Open(Filename:=repositorio_path)
        End If
    End If
    
    Dim repositorio_ws_repositorio      As Worksheet
    Dim repositorio_ws_conceptos        As Worksheet
    Dim repositorio_ws_imputaciones     As Worksheet
    
    Set repositorio_ws_repositorio = repositorio_wb.Worksheets("repositorio")
    Set repositorio_ws_conceptos = repositorio_wb.Worksheets("conceptos")
    Set repositorio_ws_imputaciones = repositorio_wb.Worksheets("imputaciones")

'2. Definiendo el archivo de nóminas

    Dim nominas_wb      As Workbook
    Dim nominas_path    As Variant
    
    ChDir "C:\Users\02775422\Desktop"
    nominas_path = Application.GetOpenFilename(Title:="Seleccione un archivo de nóminas que desee añadir al repositorio:")
    If nominas_path = False Then
        MsgBox ("La macro ha sido terminada. Si desea iniciarla de nuevo abra un archivo de nóminas.")
        Exit Sub
    Else
        Set nominas_wb = Workbooks.Open(Filename:=nominas_path)
    End If

    Dim nominas_ws      As Worksheet
    Set nominas_ws = nominas_wb.Worksheets(1)
    
'3. Loop imputaciones

%%% Here is where I am stuck %%%

'x. Cerrando los archivos
    
    Application.DisplayAlerts = False
    repositorio_wb.Close SaveChanges:=True
    nominas_wb.Close SaveChanges:=False
    Application.DisplayAlerts = True
    
'z. Mensajes y errores
    
    Dim x As String
        x = "x"
    MsgBox "Se han creado " & x & " nuevas entradas en el repositorio de nóminas."

There isn't any loop yet, since I am quite new to coding and I can't even begin to think how this sort of thing can be structured. Sorry if I am asking too much in one question and should have split this in smaller steps.

CodePudding user response：

To create the output array, just multiply the source data rows by 4. Do your calculation within a nested loop and populate your output array. Something like this:

Dim v As Variant
Dim outputArr() As Variant
Dim i As Long, j As Long, n As Long, r As Long

'Read the values from the source data sheet
With ThisWorkbook.Worksheets("Sheet1")
    v = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp)).Resize(, 10).Value2
End With

'Size the output array - simply source rows * 4.
n = UBound(v, 1)
ReDim outputArr(1 To n * 4, 1 To 3)

'Make the calculation and populate the output array.
r = 1
For i = 1 To n
    For j = 1 To 4
        outputArr(r, 1) = v(i, 1) 'Id
        outputArr(r, 2) = v(i, j * 2   1) 'description
        outputArr(r, 3) = v(i, 2) * v(i, j * 2   2) 'amount
        r = r   1
    Next
Next

'Write output to sheet.
ThisWorkbook.Worksheets("Sheet2").Range("A2").Resize(UBound(outputArr, 1), UBound(outputArr, 2)).Value = outputArr