我在工作簿中使用此代码已有一段时间,然后离开并再次进行访问,发现该代码不再像以前那样起作用。我看不到任何明显的错误,并且想知道是否有人可以发现阻止它运行的原因?
页面名称和位置保持不变。
目的是在工作表4(CAL)中取得结果,并将每行复制到一次存款准备金中的新空行中。没有错误显示。根本没有任何反应。
Sub ca_act()
Dim nextrow As Long
nextrow = Sheet4.Cells(4, "A").End(xlUp).Row + 1
Dim src As Worksheet
Set src = Sheets("CAL")
Dim trgt As Worksheet
Set trgt = Sheets("RRR")
Dim i As Long
For i = 1 To src.Range("y" & Rows.Count).End(xlUp).Row
If src.Range("y" & i) = 1 Then
' calling the copy paste procedure
CopyPaste src, i, trgt
End If
Next i
Application.ScreenUpdating = True
End Sub
' this sub copies and pastes the entire row into a different sheet
' below the last used row
Private Sub CopyPaste(ByRef src As Worksheet, ByVal i As Long, ByRef trgt As Worksheet)
src.Activate
src.Rows(i & ":" & i).Copy
trgt.Activate
Dim nxtRow As Long
nxtRow = trgt.Range("y" & Rows.Count).End(xlUp).Row + 1
trgt.Rows(nxtRow & ":" & nxtRow).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
答案 0 :(得分:1)
以下行表示您将检查“ A”列中的值
Dim nextrow As Long
nextrow = Sheet4.Cells(4, "A").End(xlUp).Row + 1
这可能是您的第一个主意。顺便说一句,您应该将其注释掉,因为它没有用。
以后写
For i = 1 To src.Range("Y" & Rows.Count).End(xlUp).Row
,这意味着您正在检查列“ Y”。你确定吗?
我会考虑以下内容:
- 您正在检查错误列中的值。
- 您的工作表CAL和$ RRR可能有误,例如,您已将CAL的名称更改为到没有数据的Sheet2。
- 在“ RRR”工作表中,“ Y”列下方可能有一些不需要的数据;即,如果您不小心在某个单元格中放入一些数据,则该数据将在该单元格处停下来并向下一行写入在那里,您没有看到它。
- 这是在不同的工作簿中发生的。
这是怎么回事
Application.ScreenUpdating = True
何时
Application.ScreenUpdating = False
无处可寻。
这是第二个子代码的简化:
Private Sub CopyPaste(src As Worksheet, i As Long, trgt As Worksheet)
src.Rows(i).Copy (trgt.Rows(trgt.Range("Y" & Rows.Count).End(xlUp).Row + 1))
End Sub
常量是救生员,您可能很快就会看到。
习惯上在不再需要或至少在代码末尾释放对象变量。以下代码不使用通过 Parent属性实现的任何对象变量。
'*******************************************************************************
' Checks a column for a specified value, and each time it is found copies
' the entire current row to another worksheet below its last used row, using
' the CopyPaste_Simple Sub.
'*******************************************************************************
Sub ca_act_Simple()
Application.ScreenUpdating = False
Const strSource As Variant = "CAL" ' Source Worksheet Name/Index
Const strTarget As Variant = "RRR" ' Target Worksheet Name/Index
Const vntSourceCol As Variant = "Y" ' Source Column Letter/Number
Const lngSourceRow As Long = 1 ' Source First Row
Const vntSearch as Variant = 1 ' Search Value
Dim intRow As Long ' Row Counter
With ThisWorkbook.Worksheets(strSource)
For intRow = lngSourceRow To _
.Cells(.Rows.Count, vntSourceCol).End(xlUp).Row
If .Cells(intRow, vntSourceCol) = vntSearch Then
' calling the copy paste procedure
CopyPaste_Simple .Parent.Worksheets(strSource), intRow, _
.Parent.Worksheets(strTarget)
End If
Next
End With
Application.ScreenUpdating = True
End Sub
'*******************************************************************************
'*******************************************************************************
' Copies the entire row to another worksheet below its last used row calculated
' from a specified column.
'*******************************************************************************
Sub CopyPaste_Simple(Source As Worksheet, SourceRowNumber As Long, _
Target As Worksheet)
' It is assumed that the Target Worksheet has headers i.e. its first row
' will never be populated.
Const vntTargetCol As Variant = "Y" ' Target Column Letter/Number
With Target
Source.Rows(SourceRowNumber).Copy (.Rows(.Cells(.Rows.Count, _
vntTargetCol).End(xlUp).Row + 1))
End With
End Sub
'*******************************************************************************
为了改进,我们将删除第二个子代码:
'*******************************************************************************
' Checks a column for a specified value, and each time it is found copies
' the entire current row to another worksheet below its last used row
' calculated from a specified column.
'*******************************************************************************
Sub ca_act_Improve()
Application.ScreenUpdating = False
Const strSource As Variant = "CAL" ' Source Worksheet Name/Index
Const strTarget As Variant = "RRR" ' Target Worksheet Name/Index
Const vntSourceCol As Variant = "Y" ' Source Column Letter/Number
Const vntTargetCol As Variant = "Y" ' Target Column Letter/Number
Const lngSourceRow As Long = 1 ' Source First Row
Const vntSearch as Variant = 1 ' Search Value
Dim intRow As Long ' Row Counter
With ThisWorkbook.Worksheets(strSource)
For intRow = lngSourceRow To _
.Cells(.Rows.Count, vntSourceCol).End(xlUp).Row
If .Cells(intRow, vntSourceCol) = vntSearch Then
With .Parent.Worksheets(strTarget)
.Parent.Worksheets(strSource).Rows(intRow).Copy _
(.Rows(.Cells(.Rows.Count, vntTargetCol).End(xlUp).Row + 1))
End With
End If
Next
End With
Application.ScreenUpdating = True
End Sub
'*******************************************************************************
在此改进的版本中,最明显的是您在两个工作表中都使用了“ Y”列,这可能是造成麻烦的原因。
我认为最好添加第四个参数:
'*******************************************************************************
' Copies an entire row to another worksheet below its last used row.
'*******************************************************************************
Sub CopyPaste_Improve(Source As Worksheet, SourceRowNumber As Long, _
Target As Worksheet, TargetColumnLetterNumber As Variant)
' It is assumed that the Target Worksheet has headers i.e. its first row
' will never be populated.
With Target
Source.Rows(SourceRowNumber).Copy (.Rows(.Cells(.Rows.Count, _
TargetColumnLetterNumber).End(xlUp).Row + 1))
End With
End Sub
'*******************************************************************************