【一个小Demo】用VBA对EXCEL进行操作:通过某一列的值寻找该值所在行的所有内容,且复制到另一张表中

您所在的位置:网站首页 vba保存到当前位置 【一个小Demo】用VBA对EXCEL进行操作:通过某一列的值寻找该值所在行的所有内容,且复制到另一张表中

【一个小Demo】用VBA对EXCEL进行操作:通过某一列的值寻找该值所在行的所有内容,且复制到另一张表中

2023-07-17 15:33| 来源: 网络整理| 查看: 265

转载请注明出处:https://blog.csdn.net/weixin_43330377/article/details/112055418 前几天放假回家,父亲让我写一个可以对EXCEL进行操作的小demo:通过某一列的值寻找该值所在行的所有内容,且复制到另一张表中。 感觉很简单,就答应了 考虑到电脑环境、操作性、简易性等。我决定用VBA来写。毕竟是内置语言,这样父亲用着也方便。 可能有很多人不清楚VBA,以下来自百度百科。 如果不是父亲让我写这个,确实都不知道VBA这个语言

VBA(Visual Basic for Applications)是Visual Basic的一种宏语言,是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。主要能用来扩展Windows的应用程序功能,特别是Microsoft Office软件。它也可说是一种应用程式视觉化的 Basic 脚本。 1993年由微软公司开发的应用程序共享一种通用的自动化语言--------即Visual Basic for Application(VBA),实际上VBA是寄生于VB应用程序的版本。1994年发行的Excel 5.0版本中,即具备了VBA的宏功能。

这个DEMO其实很简单,但苦于从没有接触过,且规则和我平时学的大不相同,写起来十分憋屈。 我是一边学一边写,思路到哪里,就根据那个思路去看帮助文档。

功能示意 在这里插入图片描述 sheet1中填写需要提取的列值 在这里插入图片描述 sheet2中是需要提取的表 在这里插入图片描述 sheet3是提取后的结果 在这里插入图片描述 大致思想 通过filedialog打开任意目录下任意数量的任意工作簿

With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Show For lngCount = 1 To .SelectedItems.count'遍历,可以打开多个工作簿' path = .SelectedItems(lngCount) Workbooks.Open(path).Activate

将当前选中路径打开并设置为活动簿

path = .SelectedItems(lngCount) Workbooks.Open(path).Activate

将表属性名称复制到sheet3

Sheets("Sheet2").Select'对sheet2进行操作' Rows(1).Copy 'row是行' Sheets("Sheet3").Select Rows(1).Select ActiveSheet.Paste'粘贴到当前活动表'

开始从sheet1第2行与sheet2除第一行外所有行进行比较,相同进行复制粘贴,直至sheet1单元格内容为空。

Sheets("sheet1").Select i = 1 For Each x In Range("A2:A65536") If x.Value "" Then i = i + 1 arr(i) = Range("A" & i) Sheets("Sheet2").Select For ii = 2 To 65536 If Range("A" & ii) = arr(i) Then Rows(ii).Select Selection.Copy Sheets("Sheet3").Select Rows(i).Select ActiveSheet.Paste End If Next End If Sheets("sheet1").Select Next

总和

Sub Copy2() Dim lngCount As Long Dim arr(500) As Variant Dim path As String Dim x As Range Dim i, count As Integer With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Show For lngCount = 1 To .SelectedItems.count ' MsgBox .SelectedItems(lngCount)’ path = .SelectedItems(lngCount) Workbooks.Open(path).Activate Sheets("Sheet2").Select Rows(1).Copy Sheets("Sheet3").Select Rows(1).Select ActiveSheet.Paste Sheets("sheet1").Select i = 1 For Each x In Range("A2:A65536") If x.Value "" Then i = i + 1 arr(i) = Range("A" & i) Sheets("Sheet2").Select For ii = 2 To 65536 If Range("A" & ii) = arr(i) Then Rows(ii).Select Selection.Copy Sheets("Sheet3").Select Rows(i).Select ActiveSheet.Paste End If Next End If Sheets("sheet1").Select Next Next lngCount End With End Sub

最后,这个demo虽小,但运行很占内存,如果U盘读写速度不是很快,不建议直接在U盘下进行,容易死机。



【本文地址】


今日新闻


推荐新闻


CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3