【一个小Demo】用VBA对EXCEL进行操作:通过某一列的值寻找该值所在行的所有内容,且复制到另一张表中 |
您所在的位置:网站首页 › vba保存到当前位置 › 【一个小Demo】用VBA对EXCEL进行操作:通过某一列的值寻找该值所在行的所有内容,且复制到另一张表中 |
转载请注明出处: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其实很简单,但苦于从没有接触过,且规则和我平时学的大不相同,写起来十分憋屈。 我是一边学一边写,思路到哪里,就根据那个思路去看帮助文档。 功能示意 将当前选中路径打开并设置为活动簿 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 |