|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
代码如下。。。。
Sub 矩形1_Click() '改好,可以使用,有点慢
Dim I As Long
Dim A As Worksheet
Dim lastRow As Long
Set A = ThisWorkbook.Sheets("Sheet2")
Set b = ThisWorkbook.Sheets("Sheet1")
For I = 1 To 1000
b.Range("A2:M2").Copy
b.Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If b.Cells(4, 1).Value = 1 Then
b.Range("A4:M4").Copy
lastRow = A.Cells(A.Rows.Count, "A").End(xlUp).Row
Selection.Copy Destination:=A.Range("A" & lastRow + 1)
End If
Next
End Sub
Sub 矩形3_Click() '改用数组,提高速度
Dim I As Long
Dim A As Worksheet
Dim lastRow As Long
Set A = ThisWorkbook.Sheets("Sheet2")
Set b = ThisWorkbook.Sheets("Sheet1")
ReDim brr(1 To 1000, 1 To 13)
n = 0
For I = 1 To 1000
b.[a3] = "=t(now())"
arr = b.Range("A2:M2").Value
If arr(1, 1) = 1 Then
n = n + 1
For j = 1 To UBound(arr, 2)
brr(n, j) = arr(1, j)
Next
End If
Next
b.[a3] = Empty
lastRow = A.Cells(A.Rows.Count, "A").End(xlUp).Row
If n > 0 Then A.Cells(lastRow + 1, "A").Resize(n, 13) = brr
Beep
End Sub
|
评分
-
2
查看全部评分
-
|