Question

VBA的新增功能，如果Y列包含某些文本（CHK），则尝试编写一个宏来复制条目的参考号（A列）。我已经能够建立一个数组，该数组将检查一个单元格是否包含值CHK并复制引用号（如果有的话）（然后对每个单元格重复此操作）。

我正在努力将每个单元格的值粘贴到另一个工作簿的A行中的下一个空单元格中。我已经设法将值复制到下一个空单元格中，但是我不确定如何向下移动一个单元格以进行数组的下一次运行。而目前，每次运行数组时，单元格中的值都会被覆盖

我当前的代码如下所示：

Sub Copy_detailed_WithNum_V2()

Application.ScreenUpdating = True

Dim ws1 As Worksheet, ws2 As Worksheet
Dim SrchRng As Range, cel As Range

Set ws1 = Sheets("Detailed Register-All")
Set ws2 = Sheets("VIPP Register")
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

'Activate Detailed Reigster sheet
ws1.Activate

Set SrchRng = Range("Y:Y")


For Each cel In SrchRng

    'Check if the cell contains CHK text
    If InStr(1, cel.Text, "CHK") Then
    'Copy rerference number if entry has CHK value
    cel.Offset(0, -24).Copy
    'Activate VIPP Register sheet
    ws2.Activate
    'Paste in the next empty cell in Coulmn A
    Cells(lastRow + 1, 1).PasteSpecial xlPasteValues

    End If

'Check next cell
Next cel

End Sub

Answer 1

此问题很可能是由于您的Range和Cells实例不符合工作表的条件。另外，请注意，您无需Activate工作表即可对其进行修改。

您可以仅将2个范围的值设置为彼此相等，而不是复制值，这就是我在这里所做的。

懒惰，您的搜索范围当前设置为Y:Y，即整个列（要检查的单元格略超过100万个）。您需要将其最小化到最小/必要范围。我将此设置从Y2开始（假设您有标题），然后向下扫描到列Y中的最后使用的单元格

Sub Copy_detailed_WithNum_V2()

Dim ws1 As Worksheet: Set ws1 = Sheets("Detailed Register-All")
Dim ws2 As Worksheet: Set ws2 = Sheets("VIPP Register")
Dim SrchRng As Range, cel As Range, lastRow As Long

Set SrchRng = ws1.Range("Y2:Y" & ws1.Range("Y" & ws1.Rows.Count).End(xlUp).Row)

Application.ScreenUpdating = False
    For Each cel In SrchRng
        If InStr(1, cel.Text, "CHK") Then
            lastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1).Row
            ws2.Cells(lastRow, 1).Value = cel.Offset(0, -24).Value
        End If
    Next cel
Application.ScreenUpdating = True

End Sub

Excel VBA-复制数组中的单元格并粘贴到下一个空单元格

1 个答案: