我知道之前已经完成了这项工作,但是我遇到了一个问题,我想更改此脚本的一部分,我只是不知道如何。
这是代码,下面是我需要做的。
Option Explicit
Sub PENCMR()
Dim i As Integer
With Application
.ScreenUpdating = False
End With
'Internal NCMR
Dim wsPE As Worksheet
Dim wsNDA As Worksheet
'Copy Ranges
Dim c As Variant
'Paste Ranges
Dim p As Range
'Setting Sheet
Set wsPE = Sheets("Print-Edit NCMR")
Set wsNDA = Sheets("NCMR Data")
Set p = wsPE.Range("A54:U54")
With wsPE
c = Array(.Range("AG3"), .Range("B11"), .Range("B14"), .Range("B17"), .Range("B20"), .Range("B23") _
, .Range("Q11"), .Range("Q14"), .Range("Q17"), .Range("Q20"), .Range("R25"), .Range("V23") _
, .Range("V25"), .Range("V27"), .Range("B32"), .Range("B36"), .Range("B40"), .Range("B44") _
, .Range("D49"), .Range("L49"), .Range("V49"))
End With
For i = LBound(c) To UBound(c)
p(i + 1).Value = c(i).Value
Next
With wsNDA
Dim rFind As Long, NR As Long, LR As Long, LC As Long
LR = .Range("C" & Rows.Count).End(xlUp).Row
LC = .Cells(2, Columns.Count).End(xlToLeft).Column
NR = LR + 1
rFind = wsNDA.Range("A3:A" & LR).Find(wsPE.Range("A54:U54")).Row
.Range("A54", .Cells(2, LC)).Copy
.Range("A" & rFind).PasteSpecial xlPasteValues
.Range("A54", .Cells(1, LC)).ClearContents
End With
With Application
.ScreenUpdating = True
End With
End Sub
脚本的意思是这样做:
当代码被激活时,它意味着复制所有单元格然后将它们粘贴到表单下面的一行中,然后在引用第二页后将新创建的行的第一个单元格与第二页面列表进行比较复制和替换信息。
我想看到的,因为我被告知可以在不粘贴到同一页面的情况下完成,复制数据,在第二张纸上搜索ID号,然后粘贴说行与新数据。
这是表格:
现在写的方式,它不会替换信息,只是用空白信息覆盖它。我还没弄清楚为什么...希望通过这个请求重写,我将能够解决这个问题。
再次感谢您的帮助。到目前为止,这个地方在帮助我不仅学习,而且从长远来看能够聪明地写作方面做得非常棒。
答案 0 :(得分:1)
一些建议的更改:
Sub PENCMR()
Dim i As Integer
'Internal NCMR
Dim wsPE As Worksheet
Dim wsNDA As Worksheet
Dim c As Variant 'Copy Ranges
Dim p As Range 'Paste Ranges
Application.ScreenUpdating = False
'Setting Sheet
Set wsPE = Sheets("Print-Edit NCMR")
Set p = wsPE.Range("A54:U54")
Set wsNDA = Sheets("NCMR Data")
c = Array("AG3", "B11", "B14", "B17", "B20", "B23" _
, "Q11", "Q14", "Q17", "Q20", "R25", "V23" _
, "V25", "V27", "B32", "B36", "B40", "B44" _
, "D49", "L49", "V49")
For i = LBound(c) To UBound(c)
p(i + 1).Value = wsPE.Range(c(i)).Value
Next
With wsNDA
Dim NR As Long, LR As Long, LC As Long
Dim f As Range
LR = .Range("C" & Rows.Count).End(xlUp).Row
LC = .Cells(2, Columns.Count).End(xlToLeft).Column
NR = LR + 1
'find matching row if it exists
Set f = .Range("A3:A" & LR).Find(what:=p.Cells(1).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
f.Resize(1, p.Cells.Count).Value = p.Value
Else
'what should happen if not found?
End If
End With
Application.ScreenUpdating = True
End Sub