ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
123
返回列表 发新帖
楼主: ddz79101

[求助] 尾到尾

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-11-8 20:50 | 显示全部楼层
请参考。。。

导入.rar

22.16 KB, 下载次数: 6

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-11-8 21:13 | 显示全部楼层

谢谢老师!运行成功!

TA的精华主题

TA的得分主题

发表于 2024-11-9 12:30 | 显示全部楼层
ykcbf1100 发表于 2024-11-8 15:29
表名应该是文本格式的吧。
sh.name=3  这个应该是sh.name="3"吧

好像会自动转换成字符类型

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-11-12 19:30 | 显示全部楼层
ykcbf1100 发表于 2024-11-8 12:34
附件供参考。。。
自动判断工作表是否已存在,已存在只复制数据,否则先新增表,然后再复制数据。

老师!我看你以前将代码导入切换到导出,只是稍改了就可了,我也尝试着将你的代码由导入的改为导出,但多次修改未成。老师!你可以帮忙看看嘛?谢谢!

导出.zip

22.79 KB, 下载次数: 2

TA的精华主题

TA的得分主题

发表于 2024-11-12 19:43 | 显示全部楼层
ddz79101 发表于 2024-11-12 19:30
老师!我看你以前将代码导入切换到导出,只是稍改了就可了,我也尝试着将你的代码由导入的改为导出,但多 ...

我改一下,你对照再看一下。

导出.zip

27.83 KB, 下载次数: 1

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-11-12 19:43 | 显示全部楼层
反向操作。。。

  1. Sub ykcbf()   '//2024.11.12
  2.     Application.ScreenUpdating = False
  3.     Set ws = ThisWorkbook     'ws
  4.     p = ws.Path & ""         'ws
  5.     With Application.FileDialog(msoFileDialogFilePicker)
  6.         .InitialFileName = p
  7.         .Title = "请选择对应Excel文件"
  8.         .AllowMultiSelect = False
  9.         .Filters.Clear
  10.         .Filters.Add "Excel文件", "*.xls*"
  11.         If .Show Then f = .SelectedItems(1) Else Exit Sub
  12.     End With
  13.     Set wb = Workbooks.Open(f, 0)     'wb
  14.     On Error Resume Next
  15.     With ws     'ws
  16.         For Each sh In .Sheets
  17.             If Val(sh.Name) Then
  18.                 arr = sh.UsedRange
  19.                 Set sht = wb.Sheets(sh.Name)
  20.                 If Err <> 0 Then
  21.                     Set sht = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
  22.                     sht.[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
  23.                     sht.Name = sh.Name
  24.                 Else
  25.                     sht.Cells.ClearContents
  26.                     sht.[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
  27.                     sht.Name = sh.Name
  28.                 End If
  29.             End If
  30.         Next
  31.     End With
  32.     wb.Close 1
  33.     Application.ScreenUpdating = True
  34.     MsgBox "OK!"
  35. End Sub

复制代码


TA的精华主题

TA的得分主题

 楼主| 发表于 2024-11-12 21:44 | 显示全部楼层
ykcbf1100 发表于 2024-11-12 19:43
我改一下,你对照再看一下。

谢谢老师!运行成功!我想得太简单了,变化的真多!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-21 18:31 , Processed in 0.039102 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表