VBA- Копирование значений из одной ячейки в другую ячейку смещения

Question

Я пытаюсь пройти через строку 6 и из столбца с 1 по 26 и искать предложение Заработанные кумулятивные часы. Как только это будет сделано, я попытаюсь перейти от строки 8 к последней строке (30 в этом случае) для столбца с заработанными кумулятивными часами в строке 6. Затем я пытаюсь вставить значения ячеек из этого столбца до 2 ячеек, оставшихся в одной строке. Но я продолжаю получать ошибки, и код не работает.

Может кто-нибудь указать мне в правильном направлении? Благодаря

Sub project() 

    Dim lastrow As Long 
    Dim i As Long 
    Dim j As Long 

    lastrow = Sheets("Progress").Cells(Rows.Count, 26).End(xlUp).Row 

    For j = 1 To 26 
     If Cells(6, j) = "Earned Cumulative Hours" Then 
      For i = 8 To lastrow 
       Cells(i, j).Copy 
       Cells(i, j).Offset(0, -2).Select 
       Selection.PasteSpeical Paste:=xlPasteValues 
      Next i 
     End If 
    Next j 
End Sub 

Answer 1

Есть несколько проблем, я могу видеть сразу с вашим кодом. Во-первых, если вы компенсируете два столбца .Cells(i, j).Offset(0, -2), тогда вы будете перезаписывать существующие значения. Если это то, что вы намереваетесь делать, то странно, но хорошо.

Следующая проблема заключается в том, что у вас возникла проблема, если «Заработанные кумулятивные часы» находятся в столбце A. Если это ваш случай, Excel будет самым несчастливым, пытаясь компенсировать два столбца слева и даст ошибку.

В этом случае вместо копирования и вставки будет более эффективно устанавливать значения в одном столбце на другие, которые вы можете видеть в моем коде. Наконец, ваши ссылки на ячейки будут действительны только для активного листа. Вы должны определить, какой рабочий лист вам интересен, как показано в моем коде. Обычно я помещаю это в начало кода, если он является автономным блоком.

Вы также можете устранить цикл i и задать диапазон значений за один раз, но мы сохраним это в следующий раз!

Я не тестировал этот код, но все должно быть хорошо.

Sub projectawesome() 

    Dim lastrow as Long, i as Long, j as Long 

    'Qualify the sheet (assuming its in the activeworkbook) 
    With Sheets("Progress") 
     lastrow = .Cells(.Rows.Count, 26).End(xlUp).Row 

     'I've changed this to column three to prevent offset errors. 
     For j = 3 to 26 
      If .Cells(6, j) = "Earned Cumulative Hours" Then 
       For i = 8 to lastrow 
        'Assuming overwriting data is ok. 
        'No need to copy and paste 
        .Cells(i, j - 2).Value = .Cells(i, j).Value 
       Next i 
      End If 
     Next 
    End With 
End Sub 

Answer 2

Попробуйте это и мы можем избавиться от этих выбирает

Sub project() 

Dim lastrow As Long 
Dim i As Long 
Dim j As Long 

lastrow = Sheets("Progress").Cells(Rows.Count, 26).End(xlUp).Row 

For j = 1 To 26 

    If Cells(6, j) = "Earned Cumulative Hours" Then 

     For i = 8 To lastrow 

      Cells(i, j).Copy 
      With Cells(i, j) 
       .Offset(0, -2).PasteSpecial xlPasteValues 
      End With 
     Next i ' next row 
    End If 
Next j ' next col 
End Sub