Lian
文章目录 站点概览

Lian

make thing better and simpler.

95 文章
64 标签

百度AI在代码(VBA)中的简单使用体验

发布于 2023-09-12 | 标签: machine learning | 29分钟 | 7031字数

img

一. 前言

为什么选择VBA测试呢?

  • VBA的资料规范性较差.
  • VBA的资料较少.

相比于python这些高度热门的语言, vba可以视作一种边缘测试.

二. 1

一个相对简单的示例.

那帮我写一个合并工作簿的vba程序吧

当然, 我可以帮你编写一个合并工作簿的VBA程序. 以下是一个简单的示例, 它可以将指定目录下的所有Excel工作簿合并到一个新的工作簿中:

Sub MergeWorkbooks()
    Dim filePath As String
    Dim fileName As String
    Dim targetWorkbook As Workbook
    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim targetWorksheet As Worksheet
    Dim lastRow As Long
    Dim i As Long

    '设置目标工作簿
    Set targetWorkbook = ThisWorkbook

    '获取目标工作簿的最后一行
    lastRow = targetWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

    '设置源文件路径和目标文件路径
    filePath = "C:\Users\user\Documents\" '修改为你的源文件路径
    fileName = "merged_workbook.xlsx" '修改为你的目标文件名和路径

    '遍历源文件目录下的所有文件
    fileName = Dir(filePath & "*.xlsx")
    Do While fileName <> ""
        '打开源工作簿
        Set sourceWorkbook = Workbooks.Open(fileName:=filePath & fileName)

        '遍历源工作簿中的每个工作表
        For Each sourceWorksheet In sourceWorkbook.Sheets
            '为目标工作簿添加新的工作表
            Set targetWorksheet = targetWorkbook.Sheets.Add(after:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count))
            targetWorksheet.Name = sourceWorksheet.Name

            '复制源工作表的内容到目标工作表
            sourceWorksheet.Copy after:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count - 1)
        Next sourceWorksheet

        '关闭源工作簿
        sourceWorkbook.Close SaveChanges:=False

        '获取下一个文件名
        fileName = Dir()
    Loop

    '将数据从第一个工作表复制到最后一个工作表
    targetWorkbook.Sheets(1).Cells(1, 1).AutoFill Destination:=targetWorkbook.Sheets(1).Range(targetWorkbook.Sheets(1).Cells(1, 1), targetWorkbook.Sheets(1).Cells(lastRow, 1))
End Sub

请注意, 在运行此代码之前, 你需要根据你的实际情况修改源文件路径( filePath) 和目标文件名( fileName) . 此外, 该代码将合并所有Excel工作簿( .xlsx文件) , 因此确保源目录下只包含你需要合并的Excel文件.

希望这个示例对你有所帮助! 如果你有其他问题或需求, 请随时提问.

看起来很棒的样子, 代码的规范程度应该超过绝大部分的真实用户, 一眼看过去没发现什么明显的错误, 粘贴到vbe中检查也没发现错误.

这也是百度给出的代码中, 唯一没有明显错误, 或者说执行应该是没问题的.

三. 2

来一点难的.

继续用vba帮我写一个处理json结构数据的程序

当然, 我可以帮你编写一个处理 JSON 结构数据的 VBA 程序. 在编写之前, 请确保你的 VBA 环境支持使用 Microsoft Scripting Runtime 库, 以便可以访问必要的类和方法来处理 JSON 数据. 以下是一个简单的示例程序, 它演示了如何使用 VBA 解析 JSON 字符串并从中提取数据:

' 引用 Microsoft Scripting Runtime 库
' 方法: 通过在 VBA 编辑器中依次选择菜单" 工具" ->" 引用" , 在弹出的对话框中勾选" Microsoft Scripting Runtime" 并确定

Sub ProcessJSONData()
    Dim jsonString As String
    Dim jsonObject As Scripting.Dictionary
    Dim jsonProperty As Variant

    ' 示例 JSON 字符串
    jsonString = "{""name"": ""John Smith"", ""age"": 30, ""address"": {""street"": ""123 Main St"", ""city"": ""Anytown"", ""state"": ""CA""}}"

    ' 创建 JSON 对象
    Set jsonObject = CreateObject("Scripting.Dictionary")

    ' 解析 JSON 字符串
    With jsonObject
        .Add "name", ""
        .Add "age", 0
        '这里很明显的错误 '
        Set .Add "address", CreateObject("Scripting.Dictionary")
        With .Address
            .Add "street", ""
            .Add "city", ""
            .Add "state", ""
        End With
    End With

    ' 从 JSON 字符串中提取数据并填充到 JSON 对象中
    With jsonObject
        For Each jsonProperty In Split(jsonString, ",")
            If Trim(jsonProperty) <> "" Then
                If InStr(jsonProperty, ":") > 0 Then
                    Dim keyValue As Variant
                    keyValue = Split(jsonProperty, ":")
                    If IsDictionary(keyValue(0)) Then
                        Set .Item(keyValue(0)) = CreateObject("Scripting.Dictionary")
                        Set .Item(keyValue(0)).Add keyValue(1), ""
                    Else
                        Set .Item(keyValue(0)) = keyValue(1)
                    End If
                End If
            End If
        Next jsonProperty
    End With

    ' 从 JSON 对象中提取数据并显示在工作表中
    With ThisWorkbook.Sheets("Sheet1")
        .Cells(1, 1).Value = jsonObject("name")
        .Cells(1, 2).Value = jsonObject("age")
        With jsonObject("address")
            .Cells(2, 1).Value = .Item("street")
            .Cells(2, 2).Value = .Item("city")
            .Cells(2, 3).Value = .Item("state")
        End With
    End With
End Sub

' 检查是否为字典类型
Function IsDictionary(obj As Object) As Boolean
    If TypeOf obj Is Scripting.Dictionary Then
        IsDictionary = True
    Else
        IsDictionary = False
    End If
End Function

上述代码首先定义了一个示例 JSON 字符串, 然后创建了一个 Scripting.Dictionary 对象来存储解析后的数据. 代码通过遍历 JSON 字符串中的每个属性, 并将其添加到对应的 Dictionary 对象中. 最后, 代码将 JSON 数据提取到工作表中进行显示.

请注意, 这只是一个简单的示例, 仅适用于具有特定结构的 JSON 数据. 如果你有更复杂的需求, 你可能需要使用更强大的 JSON 处理库, 例如 json.scripting 库.

对于复杂一点的内容, 可以看到明显的错误, 同时检查编译已经无法通过.

使用vba来处理json结构的数据, 这部分内容在网页上也是比较少的.

四. 3

继续加大难度

写一个vba程序获取字符串md5哈希值

以下是一个使用 VBA 编程语言获取字符串 MD5 哈希值的程序. 这个程序使用 Windows API, 所以它只能在 Windows 系统上运行. 在 Mac OS 或其他操作系统上运行可能会遇到问题.

这个代码是在 Excel VBA 环境中编写的, 因此, 如果你要在其他环境中使用, 可能需要做适当的修改.

 Option Explicit

' API 函数声明
Declare Function MD5HashFile& Lib "ole32.dll" (ByVal lpFileName As String, ByVal lpBuffer As String, ByVal nMaxBuffer As Long)

Function GetMD5Hash(strFileName As String) As String
    Dim Buffer As String
    Dim FileHandle As Long
    Dim FileLen As Long

    ' 打开文件
    FileHandle = FreeFile
    Open strFileName For Binary As #FileHandle

    ' 读取文件长度
    FileLen = LOF(FileHandle)

    ' 读取文件内容到缓冲区
    Get #FileHandle, , Buffer

    ' 计算 MD5 哈希值
    Call MD5HashFile(strFileName, Buffer, FileLen)

    ' 将哈希值转换为十六进制字符串
    GetMD5Hash = Replace(Replace(Replace(Hex(Buffer), "0", ""), "F", ""), "E", "")

    ' 关闭文件
    Close #FileHandle
End Function

你可以通过调用 GetMD5Hash 函数并传入文件名来获取文件的 MD5 哈希值. 例如:

Sub Test()
    Dim FilePath As String
    Dim Hash As String

    FilePath = "C:\YourFilePath\YourFileName.txt" ' 请替换为你的文件路径和文件名
    Hash = GetMD5Hash(FilePath)

    Debug.Print Hash ' 在 Immediate 窗口打印哈希值
End Sub

注意, 上面的代码示例只是一个基础的示例. 实际使用时, 你可能需要添加错误处理代码, 以处理可能出现的错误, 比如文件不存在或无法访问等问题.

编译检查无错误, 但是无法通过实际的测试.

实际想要的是一段将获得字符串哈希值(md5)的代码, 给出的却是文件的.

五. 4

写一个vba程序将base64图片转为jpg图片文件

以下是一个使用 VBA 将 Base64 图片转换为 JPG 图片文件的示例代码:

Sub ConvertBase64ToJPG()
    Dim base64Data As String
    Dim imageData As String
    Dim imagePath As String
    Dim fileNumber As Integer

    ' 假设 Base64 数据存储在 base64Data 变量中, 将其转换为字符串形式的图像数据
    ' 可以在此处添加代码从外部源获取 Base64 数据, 并将其存储在 base64Data 变量中

    ' 将 Base64 数据转换为图像数据
    imageData = ConvertBase64ToBinary(base64Data)

    ' 指定输出文件的路径和名称
    imagePath = "C:\example\image.jpg" ' 可以根据需要更改路径和文件名

    ' 打开文件以写入二进制数据
    fileNumber = FreeFile
    Open imagePath For Binary As #fileNumber

    ' 将图像数据写入文件
    Write #fileNumber, imageData

    ' 关闭文件
    Close #fileNumber
End Sub

Function ConvertBase64ToBinary(ByVal base64Data As String) As String
    Dim arrData As Variant
    Dim i As Long

    ' 将 Base64 数据转换为二进制数据
    ' 这里很明显的错误'
    arrData = Split(base64Data, "") ' vba的split函数并不具备将字符逐个分开的能力'
    For i = 0 To UBound(arrData)
        Select Case arrData(i)
            Case "A" To "Z", "a" To "z", "0" To "9", "+", "/"
                ConvertBase64ToBinary = ConvertBase64ToBinary & Chr(Asc(arrData(i)) - 55)
            Case "=" ' 忽略填充字符
                ' 无需执行任何操作
        End Select
    Next i
End Function

在此示例代码中, 我们定义了一个名为 ConvertBase64ToBinary 的函数, 该函数将 Base64 数据转换为二进制数据. 然后, 我们将二进制数据存储在变量 imageData 中, 将其写入文件 imagePath 中. 请注意, 我们使用 FreeFile 函数来获取可用的文件编号, 并使用 Open 和 Write 命令将数据写入文件. 最后, 我们使用 Close 命令关闭文件.

检查无错误, 但是代码无法通过实际的运行.

同时这里也有一个问题base64, 可能是其他格式的图片, 如png.

六. 5

使用vba基于内存指针操作对字符串型数组进行排序

在 VBA 中, 我们不直接使用内存指针进行操作, 这与其他一些编程语言( 如 C++ 或 Delphi) 不同. VBA 是一种基于对象的编程语言, 其设计主要是为了简化 Office 应用的开发, 所以这种语言没有提供直接操作内存指针的功能.

但是, 我们可以用 VBA 对字符串数组进行排序. 以下是一个使用 Sort 方法对字符串数组进行排序的例子:

Sub SortStringArray()
    Dim strArray() As String
    Dim i As Long, j As Long
    Dim temp As String

    '填充字符串数组
    ReDim strArray(5)
    strArray(0) = "C"
    strArray(1) = "A"
    strArray(2) = "E"
    strArray(3) = "B"
    strArray(4) = "D"

    '使用 Sort 方法对数组进行排序
    ' 明显的错误'
    Sort strArray

    '输出排序后的数组
    For i = LBound(strArray) To UBound(strArray)
        Debug.Print strArray(i) & " "
    Next i
End Sub

在上述代码中, 我们首先定义了一个字符串数组 strArray, 然后使用 Sort 方法对其进行排序. 这个方法会按照字母顺序对字符串数组进行排序. 然后我们通过一个循环来打印排序后的数组.

如果你需要对一个二维数组或者包含复杂数据类型的数组进行更复杂的操作, 那么你可能需要使用指针来操作内存. 但是这需要用到 VBA 的 PtrSafe 库和 VarPtr 函数, 并且在处理过程中需要更加小心, 因为这涉及到高级的内存管理操作, 可能会导致不稳定的问题.

这部分内容是当前的网页相对偏少的内容, 这里百度完全无法给出答案, 甚至连接近的都不是, 后面的内容典型的是一本正经胡说八道的样子, 是StrPtr而不是PtrSafe.

你上面的代码还没完善, Sort函数未定义

非常抱歉, 我的之前的回答有疏忽. 以下是完整的 Python 代码, 使用 heapq 模块实现最小堆排序算法, 以避免自定义 Sort 函数.

import heapq

def Sort(arr):
    heapq.heapify(arr)
    i = len(arr) - 1
    while i > 0:
        temp = heapq.heappop(arr)
        arr[0] = arr[i]
        arr[i] = temp
        i -= 1
        heapq.heapify(arr)
    return arr

这里使用了 Python 的标准库 heapq 中的 heapify 函数将输入的列表转换为最小堆, 然后使用堆的性质( 父节点小于或等于其子节点) 进行排序. 具体来说, 我们不断地从堆中取出最小的元素( 即堆顶元素) , 并将它放在列表的最后面, 然后将列表中最后一个元素替换为从堆中取出的最小元素的上层节点, 这样就可以保证列表中最后一个元素始终是当前堆中的最小元素. 最后返回排好序的列表即可.

这里的 Sort 函数不需要自己实现堆排序算法, 而是利用了 Python 标准库中提供的函数, 简化了代码的实现过程. 当然, 如果你想要自己实现堆排序算法, 可以参考其他算法的实现方式.

上下文的关联, 百度这里直接出现问题.

不好意, 我需要的是vba代码, 不是python的

当然, 我理解你需要的是VBA代码. 对于在Excel中使用VBA进行日期从字符串到日期的转换, 你可以使用以下代码:

Sub ConvertStringToDate()

    Dim InputString As String
    Dim DateFormat As String
    Dim ConvertedDate As Date

    ' 输入你的日期字符串
    InputString = "2023年6月30日"

    ' 日期格式, 根据实际情况修改
    DateFormat = "yyyy年mm月dd日"

    ' 将字符串转换为日期
    ConvertedDate = DateValue(InputString)

    ' 显示转换后的日期
    MsgBox ConvertedDate

End Sub

请注意, 上述代码使用的是Excel VBA的内置DateValue函数来从字符串中提取日期. 然而, 这个函数可能无法处理某些特殊格式的日期字符串. 如果你的日期字符串格式较为特殊, 可能需要使用更复杂的方式来处理.

如果需要处理的日期字符串格式比较复杂, 或者包含特殊字符, 你可能需要使用正则表达式或者其它字符串处理方法来提取日期部分. 这可能会需要更复杂的代码, 并可能需要你对VBA有更深入的了解. 如果你提供具体的日期字符串示例, 我可以帮助你设计适当的处理代码.

当尝试让百度进行修正时, 给出了更为离谱的答案.

七. 6

请写一个vba的字符串数组的排序代码

以下是一个使用VBA对字符串数组进行排序的示例代码:

Sub SortStringArray()
    Dim StringArray() As String
    Dim i As Long, j As Long
    Dim Temp As String

    ' 设置字符串数组
    ' 这里是明显的错误, 声明的数据类型错误'
    StringArray = Array("apple", "banana", "orange", "grape", "pear")

    ' 对字符串数组进行冒泡排序
    For i = LBound(StringArray) To UBound(StringArray) - 1
        For j = i + 1 To UBound(StringArray)
            If StringArray(i) > StringArray(j) Then
                Temp = StringArray(i)
                StringArray(i) = StringArray(j)
                StringArray(j) = Temp
            End If
        Next j
    Next i

    ' 输出排序后的字符串数组
    For i = LBound(StringArray) To UBound(StringArray)
        Debug.Print StringArray(i) & " "
    Next i
End Sub

在这个示例中, 我们首先定义一个字符串数组, 并设置一些值. 然后我们使用冒泡排序算法来对字符串数组进行排序. 在排序过程中, 我们使用两个循环来比较数组中的每一对元素, 并交换它们的位置, 以便最终得到一个按字母顺序排列的字符串数组. 最后, 我们使用循环输出排序后的字符串数组.

虽然声明变量出现错误, 但是改动变量的类型后, 代码可以正常运行.

这个冒泡排序算法的速度太慢了, 有没有更快的

是的, 冒泡排序算法的时间复杂度是O(n^2), 这使得它在处理大量数据时变得非常慢. 如果你需要更快的排序算法, 可以考虑使用以下几种算法:

  1. 快速排序: 这是一种非常高效的排序算法, 它的平均时间复杂度是O(n log n). 快速排序的基本思想是选择一个基准元素, 将数组分成两部分, 使得一部分的元素都比基准元素小, 另一部分的元素都比基准元素大. 然后, 对这两部分分别递归地进行快速排序.
  2. 归并排序: 这也是一种非常高效的排序算法, 它的时间复杂度是O(n log n). 归并排序的基本思想是将数组分成两半, 对每半进行排序, 然后将它们合并成一个有序的数组. 合并两个有序数组的过程是通过对每个元素进行比较来完成的.
  3. 堆排序: 堆排序是一种基于二叉堆的排序算法, 它的时间复杂度也是O(n log n). 堆排序的过程可以分为两个阶段: 构造堆和删除堆. 构造堆的过程是将数组转换成一个最大堆, 这可以在O(n)的时间内完成. 然后, 删除堆的过程是从堆中取出最大的元素并将其放在数组的末尾, 然后重新调整堆, 这可以在O(n log n)的时间内完成.
  4. Shell 排序: Shell 排序是另一种改进版的插入排序, 它可以在O(n log n)的时间内完成排序. 这种排序算法的思想是将一个大的数组分成多个小的子数组, 然后对每个子数组进行插入排序, 最后再进行一次插入排序来合并所有的子数组.

这些算法都比冒泡排序要快得多, 但是它们也有一些额外的开销, 例如需要额外的空间来存储中间结果或者需要更复杂的代码实现. 在选择排序算法时, 需要根据具体的需求和限制来决定使用哪种算法.

百度在这里出现理解上的错误.

那请用vba写一个更快的字符串数组排序算法吧

好的, 以下是使用VBA实现的快速排序算法:

Sub QuickSortArray()
    Dim StringArray() As String
    Dim i As Long, j As Long
    Dim Temp As String
    Dim Low As Long, High As Long
    Dim Partition As String

    ' 设置字符串数组
    ' 依然还是出现声明变量错误'
    StringArray = Array("apple", "banana", "orange", "grape", "pear")

    ' 对字符串数组进行快速排序
    Low = LBound(StringArray)
    High = UBound(StringArray)
    Partition = StringArray((Low + High) / 2)
    For i = Low To High - 1
        If StringArray(i) <= Partition Then
            For j = i + 1 To High
                If StringArray(j) >= Partition Then
                    Temp = StringArray(i)
                    StringArray(i) = StringArray(j)
                    StringArray(j) = Temp
                End If
            Next j
        End If
    Next i

    ' 递归排序子数组
	' 这里出现更为严重的错误'
    If Low < High Then
	' 递归的函数并无参数'
        QuickSortArray(Low, High)
    End If

    ' 输出排序后的字符串数组
    For i = LBound(StringArray) To UBound(StringArray)
        Debug.Print StringArray(i) & " "
    Next i
End Sub

这个算法的基本思想是选择一个基准元素( 称为" 枢轴" ) , 将数组分成两部分, 一部分的元素都小于或等于枢轴, 另一部分的元素都大于枢轴. 然后, 对这两部分分别递归地进行快速排序, 直到整个数组有序. 快速排序算法的时间复杂度在最坏情况下是O(n^2), 但在平均情况下是O(n log n), 这使得它成为实际应用中最常用的排序算法之一.

排序算法是最为常见的代码片段, 但是百度在这里还是出现错误.

但是python版本的就好很多了

img

八. 7

使用vba将一份json文件的数据提取到excel表格

使用VBA将JSON文件的数据提取到Excel表格可能涉及到多个步骤. 下面是一个基本的例子, 可以按照以下步骤来实现:

  1. 首先, 需要使用Microsoft Scripting Runtime库来读取JSON文件. 在VBA编辑器中, 选择" 工具" -> " 引用" , 然后选择"Microsoft Scripting Runtime".
  2. 然后, 使用以下代码读取JSON文件:
Sub ReadJSONFile()
    Dim fs As New FileSystemObject
    Dim jsonFile As TextStream
    Set jsonFile = fs.OpenTextFile("C:\path\to\your\jsonfile.json", ForReading, False)
    jsonString = jsonFile.ReadAll
    jsonFile.Close
End Sub

请确保更改路径为你JSON文件的实际路径.

  1. 然后, 需要解析JSON字符串. 这可以通过使用VBScript库中的ScriptControl对象来完成. 但是, VBA本身并不能直接支持这个库, 所以需要添加一个COM引用. 在VBA编辑器中, 选择" 工具" -> " 引用" , 然后选择"Microsoft Script Control 1.0".
  2. 使用以下代码解析JSON字符串:
Sub ParseJSON()
    Dim jsonString As String
    jsonString = "{""key1"":""value1"", ""key2"":""value2""}" ' 替换为你的JSON字符串
    Dim json As Object
    Set json = CreateObject("ScriptControl").Eval("(" & jsonString & ")")
    ' 在这里你可以访问json对象的属性, 例如: Debug.Print json("key1") 或 Debug.Print json("key2")
End Sub

最后, 将提取的数据写入Excel表格. 你可以使用Range对象的Value属性来完成这个任务. 以下是一个例子:

Sub WriteToExcel()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 替换为你需要写入的Excel工作表的名称
    With ws.Range("A1") ' 从A1单元格开始写入数据
        .Value = "Key1" ' 写入列标题
        .Offset(1, 0).Value = json("key1") ' 写入第一个值
        .Offset(2, 0).Value = json("key2") ' 写入第二个值
        ' 以此类推...
    End With
End Sub

注意: 这个例子假设你的JSON文件只有一个简单的字典. 如果你的JSON文件包含一个更复杂的数据结构( 例如数组或嵌套字典) , 你可能需要修改解析JSON的方法来正确地访问数据. 同时, 请根据实际情况调整代码中的路径和文件名.

这里给出的代码并不是连贯的, 这里显然和网页的资料缺少有关, 百度的训练资料不涉及到这部分的内容, 只能给出很零碎的片段代码.

九. 小结

上述的演示还仅仅是简单的代码片段的要求, 假如是连续性的代码要求, 例如实现a之后, 根据a的状态或者结果进行b或者进行c...如此...

上述的内容可以看到一些问题和闪光点:

  • 给出的代码片段很规范, 例如声明, 变量的名称等. 更难得的是将代码拆分成不同功能的函数, 让代码更具有阅读性, 在上述的体验中, 这是百度AI体验最好的地方.

  • 错误, 上述的7个部分的代码, 除了最简单的合并工作簿的代码, 其他代码均出现问题, 这在实际使用中, 可能是很糟糕的体验, 因为改别人写的代码, 其过程远比自己从零开始写更为痛苦. (上述的代码实际上, 很具有欺骗性, 因为从逻辑上看, 这些代码的逻辑好像是没什么问题的, 这对于问题的检查, 确定代码的错误来源可不容易).

  • 生成的代码质量非常一般

img

相比于直接在页面检索得到的结果, 直接生成的内容多是一些非常浅显的代码.

仅从上述的简单体验来看, 目前百度这个AI在(VBA)这个领域, 还是强化版本的代码片段提示器(内容的深度还有很大的挖掘空间).

百度在上下文关联上体验一般.

img

img

不要使用内置的sort函数, 请使用快速排序算法来写, 这部分的内容希望的是和前面的排序是相关联的话语, 百度并没处理好.

虽然百度AI在上述, 相对少资料的内容中表现较差, 但是对于有大量资料参考的内容却表现出非常好的适应性, 以上面1的合并表格为例.

使用vba将多个不同文件夹下的xlsx, xls文件合成一个工作簿, 以文件名为每个表的名字, 需要注意的是每个文件可能存在多个工作表, 有些表是空的, 这些表需要排除掉. 对每一张表的表头的文字进行加粗, 同时将每张表的文字改成微软雅黑.

Sub MergeExcelFiles()
    Dim folderPath As String
    folderPath = "C:\YourFolderPath\" ' 请修改为你的文件所在文件夹路径
    Dim fileExtension As String
    fileExtension = "*.xlsx, *.xls" ' 可以根据需要修改为你需要的文件扩展名, 用逗号分隔

    Dim wb As Workbook
    Set wb = Workbooks.Add ' 新建一个工作簿

    Dim fileDialog As FileDialog
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fileDialog
        .Title = "选择要合并的Excel文件"
        .Filters.Clear
        .Filters.Add "Excel Files", fileExtension
        .AllowMultiSelect = True
        If .Show = -1 Then ' 如果用户选择了文件
            Dim selectedFile As String
            For Each selectedFile In fileDialog.SelectedItems
                ' 从每个文件中读取数据并添加到当前工作簿中
                Dim sourceWb As Workbook
                Set sourceWb = Workbooks.Open(selectedFile) ' 打开源工作簿
                Dim sourceWs As Worksheet
                For Each sourceWs In sourceWb.Sheets ' 遍历源工作簿中的每个工作表
                    ' 如果工作表不为空, 则添加到当前工作簿中
                    If Not IsEmpty(sourceWs) Then
                        Set wb.Sheets(wb.Sheets.Count + 1) = sourceWs ' 将源工作表复制到新工作表中
                        wb.Sheets(wb.Sheets.Count).Name = sourceWs.Name ' 设置新工作表的名字为源工作表的名字
                        With wb.Sheets(wb.Sheets.Count)
                            .Cells(1, 1).Font.Bold = True ' 对表头的文字进行加粗
                            With .Cells(1, 1).Font
                                .Name = "Microsoft YaHei" ' 将文字改成微软雅黑
                            End With
                        End With
                    End If
                Next sourceWs
                sourceWb.Close SaveChanges:=False ' 关闭源工作簿, 不保存修改
            Next selectedFile
        End If
    End With
End Sub

' 判断一个工作表是否为空
Function IsEmpty(ws As Worksheet) As Boolean
    IsEmpty = Not ws.UsedRange.Count > 1
End Function

上述的代码展现了很高的质量.

略微变更要求, 要求对文件夹进行遍历.

使用vba遍历一个文件夹下所有xlsx, xls文件合成一个工作簿, 需要注意文件夹下存在子文件夹, 以文件名为每个表的名字, 需要注意的是每个文件可能存在多个工作表, 有些表是空的, 这些表需要排除掉. 对每一张表的表头的文字进行加粗, 同时将每张表的文字改成微软雅黑.

Sub MergeExcelFiles()
    Dim FolderPath As String
    FolderPath = "C:\YourFolderPath\" ' 请修改为你的文件所在文件夹路径
    Dim FileExtension As String
    FileExtension = "*.xlsx, *.xls" ' 可以根据需要修改为你需要的文件扩展名, 用逗号分隔

    Dim wb As Workbook
    Set wb = Workbooks.Add ' 新建一个工作簿

    Dim Folder As Object
    Dim SubFolder As Object
    Dim FileName As String
    Dim ws As Worksheet

    ' 遍历文件夹和子文件夹
    Set Folder = FSO.GetFolder(FolderPath)
    ' 这一步之只能遍历一层文件'
    For Each SubFolder In Folder.SubFolders
        For Each File In SubFolder.Files
            ' 显然这里出现了问题'
            If LCase(Right(File.Name, Len(FileExtension))) = LCase(FileExtension) Then
                ' 这段代码使用了文件系统对象模型 (FSO) 来遍历文件夹和子文件夹. 注意, 这个示例只考虑了第一个工作表. 如果文件中有多个工作表, 并且你想将它们全部添加到结果中, 你需要对代码进行一些修改. '

                ' 这里也出现问题'

                ' 打开文件并获取工作表
                Set ws = Workbooks.Open(File.Path).Sheets(1)

                ' 如果工作表不为空, 则添加到当前工作簿中
                If Not IsEmpty(ws) Then
                    Set wb.Sheets(wb.Sheets.Count + 1) = ws ' 将源工作表复制到新工作表中
                    wb.Sheets(wb.Sheets.Count).Name = ws.Name ' 设置新工作表的名字为源工作表的名字
                    With wb.Sheets(wb.Sheets.Count)
                        .Cells(1, 1).Font.Bold = True ' 对表头的文字进行加粗
                        With .Cells(1, 1).Font
                            .Name = "Microsoft YaHei" ' 将文字改成微软雅黑
                        End With
                    End With
                End If
            End If
        Next File
    Next SubFolder
End Sub

' 判断一个工作表是否为空
Function IsEmpty(ws As Worksheet) As Boolean
    IsEmpty = Not ws.UsedRange.Count > 1
End Function

当要求稍微发生变化, 代码的质量又会重新恢复原样, 拼凑的代码又变成"一本正经的胡说八道".

不得不感慨, 目前的NLP大模型, 在语义解析上的惊人能力.

顺便简单测试, 在文学内容上的表现:

img

上述内容为百度的 < 文心一言 >, 文心一言虽然内容更少, 但是给出的内容相对更为合理.

img

此为< 百度AI >, 给出的内容更多, 但是质量更差(更像一本正经胡说八道).

# machine learning
百度AI在代码(Python)中的简单使用体验 上一篇
VBA的未来 下一篇
已运行:
浏览数: 次 | 访客数: 人
Powered by Kyouichirou