Question

简单来说，数据如下所示：

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，测试和分数，并将其放在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

Answer 1

假设ID在A1中，公式应该这样做：

在E2 40中在F2 = C3中在G2 = D3

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

Answer 2

我通过改变来实现它：

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

为：

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

我在某个地方读到双重值显着更大的值 - 无论如何都要感谢所有的帮助！

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

2 个答案: