如何創建一個僅讀取范圍內每2個單元格的回圈？

我正在嘗試創建一個回圈，該回圈將遍歷一組資料，其中每一行都是一個 ID 和一個數量。這些列是成對排列的，其中第一個是目標，第二個是百分比。

我需要為每個目的地創建一行，給它它的 ID，然后將數量乘以每個乘數。我不知道如何選擇不同的乘數，因為在陣列的同一維度中有兩種型別的資訊。

這是一個示例資料集：

這就是我需要創建的：

如您所見，每對目標 乘數列都需要獲取自己的行。

編輯：這是我到目前為止的代碼：

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

還沒有任何回圈，因為我對編碼很陌生，我什至無法開始思考如何構建這種東西。對不起，如果我在一個問題上問得太多，應該把它分成更小的步驟。

uj5u.com熱心網友回復：

要創建輸出陣列，只需將源資料行乘以 4。在嵌套回圈中進行計算并填充輸出陣列。像這樣的東西：

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

標籤：擅长 vba 循环

上一篇：VBA公式不計算和動態參考

下一篇：如何清除除X、Y和Z列和A、B、C行之外的所有資料？