【一个小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其实很简单，但苦于从没有接触过，且规则和我平时学的大不相同，写起来十分憋屈。
我是一边学一边写，思路到哪里，就根据那个思路去看帮助文档。

功能示意

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盘下进行,容易死机。