Question

我正在尝试构建一个 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"))

Answer 1

请测试下一个代码。它没有经过测试，没有测试文件，但它应该可以工作。请在测试后发送一些反馈：

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 个单元格值并运行它直到它到达最后一个单元格

1 个答案: