031-查找的数据写入剪贴板-疑难千寻千解丛书（VBA）

小妖

ET疑难千寻千解丛书之EXCEL2010编程与实践

罗刚君 章兰新 黄朝阳 编著

疑难31
可以将查找到的所有数据串连并写入剪贴板中吗

如图所示包括三个班的成绩表，按姓名进行拼音排序。如何找到每个班第一名的姓名和成绩，且写入到剪贴板，让它可以粘贴到其他对象中？

è 解决方案

利用For...Next循环查找目标值，并将所有找到的字符串合并成一个字符串，最后通过SetText和PutInCl1ipboard方法将字符串存入剪贴板中。

í 操作方法

步骤1
确定活动工作表为“三个班成绩表”，按【Alt+F11】组合键打开VBE窗口。

步骤2
选择菜单“工具”→“引用”，打开如图所示的引用对话框，选择“Microsoft Forms 2.0 Object Library”。如果找不到，则可以通过“浏览”按钮找到System32文件夹中的“M2.0.DLL”文件并双击即可。

步骤3
选择菜单“插入”→“模块”，并输入以下代码：

1. 
   
2. Dim MyData As DataObject  '必须引用MS Form 2.0
   
3. Sub 查找三个班第一名并写入剪贴板()
   
4.   Dim arr, rng, i As Integer, One As Byte, Two As Byte, Three As Byte
   
5.   Dim a As Byte, b As Byte, c As Byte
   
6.   Set MyData = New DataObject '建立一个DataObject 对象
   
7.   arr = Range([a1], Cells(Rows.Count, 3).End(xlUp)).Value
   
8.   '将所有数据赋予数组，从而提速
   
9.   For i = 1 To UBound(arr) '遍历数组所有行
   
10.   '如果某行第一列等于“一班”，而且该行第三列大于变量One，那么取出其行号和成绩
    
11.     If arr(i, 2) = "一班" And arr(i, 3) > One Then One = arr(i, 3): a = i
    
12.     If arr(i, 2) = "二班" And arr(i, 3) > Two Then Two = arr(i, 3): b = i
    
13.     If arr(i, 2) = "三班" And arr(i, 3) > Three Then Three = arr(i, 3): c = i
    
14.   Next
    
15.   '将找到的所有数据串接起来，复制到 DataObject对象
    
16.   MyData.SetText arr(a, 1) & ": " & One & Chr(10) & arr(b, 1) & ": " & Two  & Chr(10) & arr(c, 1) & ": " & Three
    
17.   MyData.PutInClipboard '最后写入剪贴板
    
18. End Sub
    

复制代码

步骤4
光标置于代码中任意位置，并按【F5】键执行过程。

步骤5
选择F1单元格，按下【Ctrl+V】组合键，可以看到F1:F3区域将产生一、二、三班的最高成绩及学生姓名，表示目标对象已经存在于剪贴板中。

=============================

以上摘自《EXCEL2010编程与实践》

小妖

V白妖飘过~~~~~~~~~

kewin2008

我買的這本書前天到了，昨天看了一下，和羅剛君寫的另一本《Excel VBA範例大全》有不少是雷同的！

UNA123

{:011:}{:011:}{:011:}{:011:}

fulljy

学习了，多谢分享！