找到
1
篇与
VB
相关的结果
-
如何分割WPS中某个项目的分数据？ 以门店商品列表为例，我们可以通过筛选自提门店字段的数据，对文档进行分割成门店单数据文件。 步骤 1：打开宏编辑器（正确操作） 打开你的订单表格，按 Alt + F11 打开 VBA 编辑器（WPS/Excel 都支持）； 左侧「工程资源管理器」→ 右键你的工作簿名称 → 插入 → 模块； 在模块里粘贴下面的 VBA 代码（已适配路径、门店名称、报错处理）： Sub SplitOrderByStore_WPS() ' 声明所有变量（WPS兼容版） Dim ws As Worksheet Dim dict As Object Dim lastRow As Long, storeCol As Long, i As Long, j As Long Dim storeName As String, savePath As String Dim newWB As Workbook, newWS As Worksheet Dim rowNum As Long Dim rowArr As Variant Dim keyArr As Variant ' 存储字典所有key的数组 ' 1. 初始化工作表和字典 Set ws = ActiveSheet Set dict = CreateObject("Scripting.Dictionary") dict.CompareMode = 1 ' 忽略大小写 ' 2. 定位「自提门店」列（严格匹配表头） On Error Resume Next storeCol = ws.rows(1).Find(What:="自提门店", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False).Column On Error GoTo 0 If storeCol = 0 Then MsgBox "错误：未找到「自提门店」列，请检查表头（无空格/错别字）！", vbExclamation Exit Sub End If ' 3. 检查数据有效性 lastRow = ws.Cells(ws.rows.Count, storeCol).End(xlUp).Row If lastRow < 2 Then MsgBox "错误：没有可拆分的订单数据（数据需从第2行开始）！", vbExclamation Exit Sub End If ' 4. 存储每个门店对应的行号（用字典分组） For i = 2 To lastRow storeName = Trim(ws.Cells(i, storeCol).Value) ' 过滤空门店名 If storeName <> "" Then If Not dict.Exists(storeName) Then dict(storeName) = "" ' 初始化行号字符串 End If dict(storeName) = dict(storeName) & i & "," ' 拼接行号（用逗号分隔） End If Next i ' 5. 若没有有效门店，直接退出 If dict.Count = 0 Then MsgBox "错误：未识别到任何门店名称！", vbExclamation Exit Sub End If ' 6. 选择文件保存文件夹 With Application.FileDialog(msoFileDialogFolderPicker) .Title = "选择拆分文件的保存文件夹" .AllowMultiSelect = False If .Show <> -1 Then Exit Sub ' 用户取消选择则退出 savePath = .SelectedItems(1) & "\" End With ' 7. 把字典Keys转为数组（核心：用下标遍历替代For Each） keyArr = dict.Keys ' 提取所有门店名到数组 ' 8. 批量导出每个门店的文件（纯下标遍历） Application.ScreenUpdating = False ' 关闭屏幕刷新，提速 For j = 0 To UBound(keyArr) ' 遍历门店数组（下标从0开始） storeName = keyArr(j) ' 创建新工作簿和工作表 Set newWB = Workbooks.Add Set newWS = newWB.Sheets(1) newWS.Name = "订单数据" ' 复制表头到新文件 ws.rows(1).Copy newWS.rows(1) ' 拆分该行门店的所有行号，并用下标遍历 rowNum = 2 ' 新表从第2行开始粘贴数据 rowArr = Split(Left(dict(storeName), Len(dict(storeName)) - 1), ",") ' 去掉最后一个逗号 ' 下标遍历行号数组（替代For Each） For i = 0 To UBound(rowArr) ws.rows(CLng(rowArr(i))).Copy newWS.rows(rowNum) rowNum = rowNum + 1 Next i ' 处理门店名特殊字符（避免保存失败） Dim safeName As String safeName = Replace(Replace(Replace(Replace(storeName, "/", ""), "\", ""), ":", ""), "*", "") safeName = Replace(Replace(Replace(Replace(safeName, "?", ""), """", ""), "<", ""), ">", "") safeName = Replace(safeName, "|", "") ' 保存文件（兼容Excel/WPS格式） newWB.SaveAs Filename:=savePath & safeName & ".xlsx", FileFormat:=xlOpenXMLWorkbook newWB.Close SaveChanges:=False ' 关闭新文件 Next j Application.ScreenUpdating = True ' 恢复屏幕刷新 MsgBox "拆分成功！所有文件已保存到：" & vbCrLf & savePath, vbInformation ' 释放对象，避免内存泄漏 Set ws = Nothing Set dict = Nothing Set newWB = Nothing Set newWS = Nothing End Sub步骤 2：点击编辑器顶部的「运行」按钮（▶️），或按F5； 步骤 3：在弹出的对话框中选择空文件夹（建议新建），点击「确定」； 步骤 4：等待几秒，弹出「拆分成功」提示后，去目标文件夹查看即可。
