excel - VBA复制粘贴突然重复粘贴
问题描述
我已经运行这个脚本一段时间了,没有问题,然后今天它坏了。这是非常基本的,因为我只是从一个选项卡中过滤值,然后将它们复制并粘贴到顶行的另一个选项卡上。但是突然之间,它会粘贴这些值,然后重复粘贴这些值 19 次,总共复制粘贴 20 次。
Sheets("BSLOG").Select
Range("Q1").Select
Selection.AutoFilter Field:=17, Criteria1:="1"
Range("A1:Q5000").Select
Range("A1:Q5000").Activate
Selection.Copy
Sheets("PENDG TRADES").Select
Range("A1:Q300").Select
ActiveSheet.Paste
解决方案
FaneDuru 是对的。你也可以试试这个代码,我更喜欢它:
Option Base 1 'This means all array starts at 1. It is set by default at 0. Use whatever you prefer,depending if you have headers or not, etc
Sub TestFilter()
Dim shBSLOG As Worksheet
Dim shPENDG As Worksheet
Dim rngBSLOG As Range
Dim arrBSLOG(), arrCopy()
Dim RowsInBSLOG&
Dim i&, j&, k&
Set shBSLOG = Worksheets("BSLOG")
Set shPENDG = Worksheets("PENDG TRADES")
With shBSLOG
Set rngBSLOG = .Range(.Cells(1, 1), .Cells(5000, 17))
End With
RowsInBSLOG = rngBSLOG.Rows.Count
arrBSLOG = rngBSLOG
ReDim arrCopy(1 To RowsInBSLOG, 1 To 17) 'set the size of the new array as the original array
k = 1 'k is set to 1. This will be used to the row of the new array "arrCopy"
For i = 1 To RowsInBSLOG 'filter the array. From the row "i" = 1 to the total of rows "RowsinBSLOG
If arrBSLOG(i, 1) = 1 Then 'if the first column of the row i is equal to 1, then...
For j = 1 To 17
arrCopy(k, j) = arrBSLOG(i, j) 'copy the row
Next j
k = k + 1 'next copy will be in a new row
End If
Next i 'repeat
With shPENDG
.Range(.Cells(1, 1), .Cells(k, 17)) = arrCopy() 'place the new array in the new sheet
End With
End Sub
推荐阅读
- grails - assertequals 如何对域对象起作用?
- javascript - 此节点js代码的php中的等效加密代码如何?
- android - Android RecyclerView如何更改第一项它的文本颜色
- plot - 如何在mathematica中绘制具有不同范围的图形
- ssh - 当 IP 更改时保持 SSH 会话处于活动状态
- html - 使列高填充行引导程序4
- aws-lambda - Netlify Lambda 构建出现语法错误
- javascript - 使用 get-image-colors 包获取颜色量
- python - 将不同的dict列表与ansible结合起来
- php - 登录系统一直提示我无法登录