复制范围，偏移粘贴整个文件VBA答案

【问题标题】：Copy Range, Offset Paste through entire file VBA复制范围，偏移粘贴整个文件VBA
【发布时间】：2014-02-07 18:28:12
【问题描述】：

简单来说，数据是这样的：

ID | Value | Test | Score | 
1  | 30    | a    | b     |
1  | 40    | c    | d     |
2  | 30    | d    | a     |
2  | 40    | e    | c     |

... 130,000 行。该值始终是 30 或 40，我想将 40、Test 和 Score 替换为 30 的行，看起来像这样。

ID | Value | Test | Score |    |   |   |
1  | 30    | a    | b     | 40 | c | d |
2  | 30    | d    | a     | 40 | e | c |

我似乎无法理解值的偏移粘贴。我已经尝试过 Select.Copy 等 - 由于性能问题，我只读过关于走这条路线的坏消息。任何帮助将不胜感激！

谢谢，丹

编辑：更新——所以我已经让它工作了，但是在我收到 溢出错误之前它只会经过 40 行。我知道这不是优化的，或者根本不是最好的方法——但这是我唯一能做的事情。任何意见都非常感谢。

我发现在少数情况下只存在 1 个 ID，因此我正在检查是否有两个 ID，如果是 - 复制/粘贴，否则继续下一行。

Sub Macro4()

' Macro4 Macro
Application.ScreenUpdating = False

Range("H6:K6").Select
Application.CutCopyMode = False
Selection.Copy
Range("L5").Select
ActiveSheet.Paste

Dim r As Integer, ID As Integer, validation As Integer
r = 5

While r < 400
Range("V1:X1").Select
Selection.ClearContents
Range("V1").Select
ID = Cells(r, 1).Value
Selection.Value = ID
Range("W1").Select


ActiveCell.FormulaR1C1 = "=countifs(C[-22],RC[-1])"

validation = Selection.Value
If validation > 1 Then
Cells(r + 1, 8).Select
Range(Selection, Cells(r + 1, 11)).Select
Selection.Copy
Cells(r, 12).Select
ActiveSheet.Paste
r = r + 2
End If

If validation = 1 Then
        r = r + 1
End If

Wend
    Application.ScreenUpdating = True

End Sub

【问题讨论】：

数据是否一致？即，您是否总是有 1 行 ID、Value = 30 以及对应的 ID 和 Value = 40 的行？如果有多行具有给定 ID 和 30，而只有 1 行或没有具有相同 ID 和值 40 的行怎么办？这可能吗？
数据总是一致的。有 65,000 个唯一 ID (130,000/2)，每个 ID 有一个 40 和一个 30。我想省略的第 40 行中有很多垃圾，我的示例没有显示 - 所以我只是喜欢抓取行中的这三个单元格（并且列是这样对齐的）
大约有 100 个实例只有 1 个 ID。

标签： vba excel copy-paste offset

【解决方案1】：

假设 ID 在 A1 中，公式应该可以做到：

在 E2 40
在 F2 =C3
在 G2 =D3

向下复制以适应（确保 40 不会自动递增），在顶部选择 F:G、选择性粘贴、值...，过滤以在 ColumnB 中选择 40 并删除选定的行。

【讨论】：

【解决方案2】：

我通过改变让它工作：

Dim r As Integer, ID As Integer, validation As Integer

到：

Dim r As Integer, ID as Double, validation As Integer

我在某处读到 double 的值要大得多——感谢所有帮助，无论如何！

【讨论】：