Блог

я пытаюсь создать программу vba, в которой у меня есть 3 листа : лист 1, лист 2 и лист 3 , я введу данные на листе 2 (столбец A : столбец E), и я хочу скопировать первые 500 ric, которые будут скопированы с листа 2 (столбец B) на листе 1 (столбец A), и какой бы ни был результат, основанный на формуле refinitv на листе 1 (столбец D : столбец G), должен быть скопирован на лист 3, затем снова макрос должен перейти на лист 2, скопируйте следующие 500 ric, затем вставьте его в столбец 1 листа A и что бы ни было результат должен быть вставлен в лист 3, этот процесс должен выполняться до тех пор, пока все ric не будут покрыты листом 2. например, если лист 2 содержит в общей сложности 1200 ric, то цикл будет выполняться трижды (500 500 200 = 1200). единственная помощь, которая мне нужна, находится в разделе «Для цикла», я попробую самостоятельно.

переписывание последовательности для лучшего понимания: лист 2 : я введу данные, макрос должен выбрать первые 500 ric из столбца B и вставить их в лист 1 , столбец (A2), затем формула эйкона получит результат на основе столбца A, и макрос должен скопировать результат на лист 3, затем снова будут выбраны следующие 500 ric из листа 2, и следует следовать тому же процессу.

 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:""amp;R2C2amp;"" 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" amp; 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" amp; sh1.Range("A" amp; sh1.rows.count).End(xlUp).row).ClearContents
   sh3.Range("D2:G" amp; sh3.Range("D" amp; sh3.rows.count).End(xlUp).row).ClearContents
   'put the formula:
   sh1.Range("D2").FormulaR1C1 = "=@RHistory(R2C1,"".Timestamp;.Close"",""NBROWS:""amp;R2C2amp;"" INTERVAL:1D"",,""SORT:ASC TSREPEAT:NO CH:In;fd"",R[5]C)"
   For i = 1 To noIt
        arr2 = sh2.Range("B" amp; IIf(i = 1, 2, (lastR   1) * (i - 1)) amp; ":B" amp; (lastR   1) * i).value 'put the range in an array to make the code faster
        lastRA = sh1.Range("A" amp; sh1.rows.count).End(xlUp).row   1 'last empty row of A:A in sheet1
        sh1.Range("A" amp; 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" amp; sh1.Range("D" amp; sh1.rows.count).End(xlUp).row).value   'put the range in an array
        lastR3 = sh3.Range("D" amp; sh3.rows.count).End(xlUp).row   1                                         'last empty row of D:D in sheet3
        'drop the array content:
        sh3.Range("D" amp; 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