VBA如何创建循环仅读取区域内每隔2列的成对单元格

功能要求 #

• 遍历指定数据集，数据集每行包含ID、金额两个基础字段，后续列按*「目的地-百分比」*规则成对排布：每对列的第一列为目的地，第二列为对应分摊百分比
• 为每个目的地单独生成一行结果数据：保留原行ID，将原金额乘以对应百分比得到计算后的分摊金额
• 核心卡点：数组同一维度中存储了两类不同信息，无法准确定位选取对应的百分比乘数

结构参考 #

• 示例数据集结构：
  
• 目标输出结构：
  

每组成对的「目的地+百分比」列，需要对应生成一条单独的结果行。

现有代码框架 #

目前已完成工作簿读取、工作表定义、文件关闭逻辑的编写，卡在'3. Loop imputaciones循环环节，未实现分摊遍历逻辑，现有完整代码如下：

'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."

求助内容 #

接触VBA时间较短，尚未理清这类循环的代码结构设计思路，不清楚如何实现隔2个单元格读取成对列数据的逻辑，需要具体的实现指引。

内容的提问来源于stack exchange，提问作者user19206253