EXCEL VBA – 文件遍历、内容读取与合并、正则替换、行/列操作

一 根据文件遍历结果创建工作表

需求：

根据文件名创建工作表

在同一个文件夹下有很多文件

比如：2019-06_辽宁_沈阳_qwd.xlsx

2019-06_辽宁_葫芦岛_sdsd.xlsx

2019-06_黑龙江_sad.xls

有的是xlsx 有的是xls文件，格式都是统一的 前缀必为2019-06.同一个省份可能有多个市的文件，我想用VBA读取文件名里的省份（估计要用正则表达式？），根据每个省份在同一个excel文件里创建对应的工作表，请问该如何写代码呢？

'用FSO先获取当前目录所有文件，判断文件名是不是xls或者xlsx后缀，再判断是不是2019-06开头，并且符合2019-06_xxxx的格式。
'如果都符合，就从split的结果取出省份，遍历当前工作表，如果不存在这个省份，则新增。
'这个情况用正则省不了多少事。
Sub xxxx()
    Dim province As String, ext As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each file In fso.getfolder(".").Files
        ext = LCase(fso.GetExtensionName(file))
        Dim namesplit() As String, exist As Boolean, wkst As Worksheet
        namesplit = Split(file.Name, "_")
        If (ext = "xls" Or ext = "xlsx") And Left(file.Name, 7) = "2019-06" And UBound(namesplit) > 1 Then
            exist = False
            For Each wkst In Sheets
                If wkst.Name = namesplit(1) Then
                    exist = True
                    Exit For
                End If
            Next
            If Not exist Then
                Set wkst = Sheets.Add()
                wkst.Name = namesplit(1)
            End If
        End If
    Next
End Sub

二 汇总多个工作簿数据

需求：

在一个目录下，有n张excel工作簿数量未知，文件名未知。但是要统计的数据都位于工作簿的第二张表，且工作簿和表的结构是完全一致的。
单个表示例

汇总表：

    Dim wkst As Worksheet, wkbk As Workbook, sumA As Currency, sumB As Currency
    Set fso = CreateObject("Scripting.filesystemobject")
    For Each file In fso.getfolder("D:").Files  '到指定目录里找文件(不包含子目录）
        If LCase(Right(file.shortname, 3)) = "xls" Or _
          Mid(LCase(StrReverse(file.shortname)), 2, 3) = "slx" Then
            wkbk = Application.Workbooks.Open(file.Path) '如果文件名是 .xls或者.xls? 结尾
            wkst = wkbk.Sheets(2)                       '就打开工作簿，在第二个sheet的c列
            wkst.Cells(1, 3).Formula = "=sumif(A:A,""a"",B:B)"  '通过公式SUMIF对"a"和"b"
            wkst.Cells(2, 3).Formula = "=sumif(A:A,""b"",B:B)"  '条件求和(假定数据在AB两列)
            sumA = sumA + wkst.Cells(1, 3)                      '将公式结果累加到汇总数据中
            sumB = sumB + wkst.Cells(2, 3)
            wkbk.Close
        End If
    Next
    Debug.Print sumA, sumB

三 正则替换的应用

需求：

电子表格一些单元格有类似这样的数据：
小朱100/小刘200/小海800
小马400/小张200/大海300
……

请问，怎么用vba+正则表达式批量修改这些单元格的数字？例如，每个数字加上200，变成：
小朱300/小刘400/小海1000
小马600/小张400/大海500
……

Sub abc()
    Dim c() As String
    For i = 2 To 4
        c = Split(Sheet1.Cells(i, 1).value, "/")
        For j = 0 To UBound(c)
            c(j) = RegReplace(c(j))
        Next j
        Sheet1.Cells(i, 2) = Join(c, "/")
    Next
End Sub
 
Function RegReplace(plain As String)
    Dim value As String, regx
    value = plain
    Set regx = CreateObject("VBSCRIPT.REGEXP")
    regx.Pattern = "-*\d+(\.\d+){0,}"
    regx.Global = True
    For Each Match In regx.Execute(value)
        value = Replace(value, Match.value, (Match.value + 200))
    Next
    RegReplace = value
End Function

四 数据合并

需求：

如上图所示这样，把左边的数据源处理成右边的样式，毛重求和，箱号合并。谢谢，在线等。
求高手给写段代码供学习一下，谢谢！
E列是A列的去重复，F列是按A列筛选后B列的数据的求和，G列是F列是按A列筛选后C列的单元格文本内容的合并（中间用”，“号隔开）

Sub S()
    Dim listweight, listpack
    Set listweight = CreateObject("Scripting.Dictionary")
    Set listpack = CreateObject("Scripting.Dictionary")

    For i = 2 To Sheet1.UsedRange.Rows.Count
        Dim id As String
        Dim weight As Long
        Dim packno As String
        id = Sheet1.Cells(i, 1)
        weight = Sheet1.Cells(i, 2)
        packno = Sheet1.Cells(i, 3)
        
        If listweight.exists(id) Then
            listweight(id) = listweight(id) + weight
            listpack(id) = listpack(id) & packno & ","
        Else
            listweight(id) = weight
            listpack(id) = packno & ","
        End If
    Next i
    
    i = 1
    Sheet2.Cells(1, 1) = "提单号"
    Sheet2.Cells(1, 2) = "总重"
    Sheet2.Cells(1, 3) = "箱号"
    For Each Key In listweight.keys
        i = i + 1
        Sheet2.Cells(i, 1) = Key
        Sheet2.Cells(i, 2) = listweight.Item(Key)
        Sheet2.Cells(i, 3) = Left(listpack.Item(Key), Len(listpack.Item(Key)) - 1)
    Next
End Sub

五 excel vba如何删除选定区域内不等于指定内容的单元格所在的列

需求：

在一个数据表，任意选定区域 ，判断单元格内的值，如果等于指定值，不做任何操作，如果不等于指定的值，则把单元格所在的列删除，请教VBA如何实现。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ColStart, ColEnd, RowStart, RowEnd
    ColStart = Target.Column
    ColEnd = ColStart + Target.Columns.Count - 1
    RowStart = Target.Row
    RowEnd = RowStart + Target.Rows.Count - 1
    For i = ColEnd To ColStart Step -1
        For j = RowStart To RowEnd
            If Cells(i, j) <> "指定值" Then
                Columns(i).Delete
                Exit For
            End If
        Next j
    Next i
End Sub