VBA-将值从一个单元格复制到另一个偏移单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/28373651/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA- Copying Values from one cell to another offset cell
提问by JA16
I am trying to go through row 6 and from column 1 to 26 and search for the sentence Earned Cumulative Hours. Once that is done then I am trying to go from row 8 to the last row(30 in this case) for the column that has Earned Cumulative Hours in row 6. Then I am trying to paste the values of the cells from this column to 2 cells left in the same row. But I keep getting errors and the code doesn't work.
我试图通过第 6 行和从第 1 列到第 26 列并搜索句子 Earned Cumulative Hours。完成后，我尝试从第 8 行到第 6 行中获得累积小时数的列的最后一行（在本例中为 30）。然后我尝试将此列中的单元格值粘贴到同一行还剩 2 个单元格。但是我不断收到错误并且代码不起作用。
Can someone please point me in the right direction ? Thanks
有人可以指出我正确的方向吗？谢谢
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
回答by CuberChase
There are a few problems I can see straight away with your code. Firstly if you are offsetting back two columns .Cells(i, j).Offset(0, -2)then you will be overwriting existing values. If this is what you intend to do then weird but ok.
我可以通过您的代码立即看到一些问题。首先，如果您要抵消两列，.Cells(i, j).Offset(0, -2)那么您将覆盖现有值。如果这是你打算做的那么奇怪但确定。
The next issue is that you have a problem if 'Earned Cumulative Hours' is in Column A. If this is your case Excel will be most unhappy trying to offset two columns to the left and will give an error.
下一个问题是，如果“赚取的累计小时数”在 A 列中，您就会遇到问题。如果是这种情况，Excel 将最不高兴尝试向左偏移两列，并会给出错误。
In this case instead of copying and pasting it will be more efficient to set values in one column to the other which you can see in my code. Finally, your Cell references will be valid for the active sheet only. You need to qualify what worksheet you interest in as shown in my code. I normally put this at the start of the code if it is a self contained block.
在这种情况下，将一列中的值设置为另一列中的值而不是复制和粘贴会更有效，您可以在我的代码中看到。最后，您的单元格引用仅对活动工作表有效。您需要限定您感兴趣的工作表，如我的代码所示。如果它是一个自包含块，我通常把它放在代码的开头。
You could also eliminate the iloop and set ranges of values at a time but we'll save that for next time!
您也可以一次消除i循环并设置值的范围，但我们将其保存以备下次使用！
I haven't test this code but it should be fine.
我还没有测试这段代码，但应该没问题。
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
回答by jamesC
Try this and we can get rid of those selects
试试这个，我们可以摆脱那些选择
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
