如何在循环中复制 500 个单元格值并运行它直到它到达最后一个单元格

2024-05-20 • 问答

我正在尝试构建一个 vba 程序，其中我有 3 个工作表：工作表 1、工作表 2 和工作表 3，我将在工作表 2（A 列：E 列）中输入数据，我想复制前 500 个 rics从工作表 1（A 列）中的工作表 2（B 列）复制，并且基于工作表 1（D 列：G 列）中的 refinitv 公式得出的结果应该被复制到工作表 3，然后宏应该再次转到工作表2 复制接下来的 500 个 rics，然后将其粘贴到工作表 1 的 A 列中，结果应该粘贴在工作表 3 中，此过程应该一直运行，直到所有 rics 都包含在工作表 2 中。例如，如果工作表 2 总共有 1200 rics 然后循环将运行三次 (500 + 500+ 200 = 1200)。我需要的唯一帮助是在 for 循环部分休息，我会自己尝试。

重写序列以更好地理解：表 2：我将输入数据，宏应该从 B 列中选取前 500 个 rics 并将它们粘贴到表 1 的 (A2) 列中然后 eikon 公式将根据 A 列获取结果，宏应将结果复制到工作表 3 中然后再次从表 2 中挑选下 500 个 rics，并应遵循相同的过程。

Sub CAEvents()
Application.ScreenUpdating = False

    Dim wb As Workbook,ws As Worksheet,wsRic As Worksheet,ws1 As Worksheet
    Dim iLastRow As Long,r As Long,n As Long,i As Integer
    Dim ric As String

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    Set ws1 = wb.sheeets("Sheet2") ' as appropriate
    'n = ws.Range("B2").Value ' days
    
    ThisWorkbook.Sheets("Sheet1").Range("A2:E50000").ClearContents
    'ThisWorkbook.Sheets("Output").Cells.ClearContents
    'ThisWorkbook.Sheets("InsertSeveralSpots").Range("B6:F6").End(xlDown).clearcontent

    ' loop through rics in col I
    iLastRow = ws1.Cells(Rows.Count,"A").End(xlUp).Row
    If iLastRow >= 2 Then
        For r = 2 To iLastRow
            ric = ws.Cells(r,"I")
            ws.Range("A2").Value2 = ric
            
             ws.Range("C1").FormulaR1C1 = "=@RHistory(R2C1,"".Timestamp;.Close"",""NBROWS:""&R2C2&"" INTERVAL:1D"",""SORT:ASC tsrEPEAT:NO CH:In;fd"",R[5]C)"
            
            Application.Run "EikonRefreshWorksheet"
            
            Application.Wait (Now + TimeValue("0:00:02"))

Sub Copy500Rows() Dim sh1 As Worksheet,sh2 As Worksheet,sh3 As Worksheet,lastR2 As Long,lastRA As Long Dim lastR3 As Long,lastR As Long,arr2,arrDG,i As Long,noIt As Long,lastNr As Long Set sh1 = Worksheets("Sheet1") 'use here your necessary sheet Set sh2 = Worksheets("Sheet2") 'use here your necessary sheet Set sh3 = Worksheets("Sheet3") 'use here your necessary sheet lastR2 = sh2.Range("B" & sh2.rows.count).End(xlUp).row 'last row of B:B in sheet2 lastR = 500 'the slices to be used noIt = Int(lastR2 / lastR) 'number of necesssary iterations 'calculate the reall necessary number of iterations and the last iteration number of rows If lastR2 / lastR > noIt Then If noIt > 0 Then lastNr = lastR2 - noIt * lastR noIt = noIt + 1 Else lastR = lastR2: noIt = 1 End If ElseIf lastR2 / lastR < noIt Then lastR = lastR2: noIt = 1 End If sh1.Range("A2:A" & sh1.Range("A" & sh1.rows.count).End(xlUp).row).ClearContents sh3.Range("D2:G" & sh3.Range("D" & sh3.rows.count).End(xlUp).row).ClearContents 'put the formula: sh1.Range("D2").FormulaR1C1 = "=@RHistory(R2C1,"".Timestamp;.Close"",""NBROWS:""&R2C2&"" INTERVAL:1D"",""SORT:ASC TSREPEAT:NO CH:In;fd"",R[5]C)" For i = 1 To noIt arr2 = sh2.Range("B" & IIf(i = 1,2,(lastR + 1) * (i - 1)) & ":B" & (lastR + 1) * i).value 'put the range in an array to make the code faster lastRA = sh1.Range("A" & sh1.rows.count).End(xlUp).row + 1 'last empty row of A:A in sheet1 sh1.Range("A" & lastRA).Resize(UBound(arr2),1).value = arr2 'drop the array content in the last empty row of sheet1 sh1.Calculate 'calculate arrDG = sh1.Range("D2:G" & sh1.Range("D" & sh1.rows.count).End(xlUp).row).value 'put the range in an array lastR3 = sh3.Range("D" & sh3.rows.count).End(xlUp).row + 1 'last empty row of D:D in sheet3 'drop the array content: sh3.Range("D" & lastR3).Resize(UBound(arrDG),UBound(arrDG,2)).value = arrDG If i = noIt - 1 And lastNr > 0 Then lastR = lastNr Next i MsgBox "Ready..." End Sub

如何在循环中复制 500 个单元格值并运行它直到它到达最后一个单元格

kdokdokdop 回答：如何在循环中复制 500 个单元格值并运行它直到它到达最后一个单元格

大家都在问