ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: skiss

[求助] 自动提取生产数据

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-4-26 09:32 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
具体见附件内容

New folder.zip

55.96 KB, 下载次数: 7

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-4-26 09:35 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
microyip 发表于 2017-4-26 09:23
1、代码是一次生成所有文本文件的呀,如图,输入100后得到的文件

2、上面得到文本内容有误,是因为Copy ...

对,是一次生成的,是我测试有误,只是需要指定第一个文本名和文本。
micro老师,我之所以想实现文本名称通过表格中ID列内容按照顺序命名是因为文本的名称可能不是连续,如果数据量很大,生成很多个文本,就需要手工去修改那些不连续的文本,如果我提前在ID列中将所有的文本名称连续列出来,不管它是不是连续,也能得到想要的数据。
比如生成文本名称为800023,内容是1~200的数据,80027,内容是201~400的数据,文本名称就可以随机了,或者是按照我自定义的方式按顺序生成的。

TA的精华主题

TA的得分主题

发表于 2017-4-26 09:42 | 显示全部楼层
没人知道你的定义规则,所以你按你自己的规则进行修改一下就可以了

TA的精华主题

TA的得分主题

发表于 2017-4-26 09:46 | 显示全部楼层
反正文本里的每截内容都有对应参数,你根据你的需求,修改对应参数就是啦

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-4-26 10:13 | 显示全部楼层
microyip 发表于 2017-4-26 09:46
反正文本里的每截内容都有对应参数,你根据你的需求,修改对应参数就是啦

规则就是我提前在表格ID这个列中输入文本的名称,然后按照顺序生成对应文本即可
QQ截图20170426101229.jpg

TA的精华主题

TA的得分主题

发表于 2017-4-26 10:21 | 显示全部楼层
skiss 发表于 2017-4-26 10:13
规则就是我提前在表格ID这个列中输入文本的名称,然后按照顺序生成对应文本即可

你把nID 那里改成对应读取这个就可以了

TA的精华主题

TA的得分主题

发表于 2017-4-26 10:29 | 显示全部楼层
  1. Sub 生成数据()
  2.     Dim vData As Variant, sPath As String
  3.     Dim sItemNumber As String, vID As Variant, nID As Double, nFile As Integer
  4.     Dim nNum As Integer, nI As Integer, nJ As Integer, nRow As Double
  5.    
  6.     Application.ScreenUpdating = False
  7.     Application.DisplayAlerts = False
  8.     Do
  9.         sPath = InputBox("请输入需要分隔数据数量:")
  10.         nNum = Val(sPath)
  11.         If nNum = 0 Then _
  12.             If MsgBox("输入有误或未输入,是否取消输入?", vbYesNo) = vbYes Then GoTo 退出生成数据
  13.     Loop While nNum = 0
  14.     vData = False
  15.     Do
  16.         vData = Application.GetOpenFilename(filefilter:="文件,*.*")
  17.         If vData = False Then _
  18.             If MsgBox("是否取消生成数据?", vbYesNo) = vbYes Then GoTo 退出生成数据
  19.     Loop While vData = False
  20.     sPath = vData
  21.     vData = Split(sPath, "")
  22.     sPath = Left(sPath, Len(sPath) - Len(vData(UBound(vData))))
  23.     sItemNumber = [H3].Text
  24.     nRow = Cells(Rows.Count, [I:I].coloumn).End(xlUp).Row
  25.     vID = [I1].Resize(nRow).Value
  26.     vData = Sheet1.UsedRange.Value
  27.     nFile = Int((UBound(vData) - 1) / nNum) + 1
  28.     For nI = 0 To nFile - 1
  29.         If nI > UBound(vID) - 3 Then Exit For
  30.         nID = vID(nID - 3)
  31.         If Dir(sPath & nID & ".txt") <> "" Then Kill sPath & nID & ".txt"
  32.         For nJ = 1 To nNum
  33.             nRow = nI * nNum + nJ
  34.             If nRow = 1 Then
  35.                 nJ = 1
  36.                 nRow = 2
  37.             End If
  38.             If nRow > UBound(vData) Or vData(nRow, 1) = "" Then Exit For
  39.             If nJ = 1 Then
  40.                 Open sPath & nID & ".txt" For Output As #1
  41.                 Print #1, "ID,Index,ItemNumber,serial,Timestamp"
  42.             End If
  43.             Print #1, nID & "," & nJ & "," & sItemNumber & "," & vData(nRow, 1) & "," & vData(nRow, 2) & vData(nRow, 3)
  44.         Next nJ
  45.         Close #1
  46.     Next nI
  47.     MsgBox "完成!"
  48. 退出生成数据:
  49.     Application.ScreenUpdating = True
  50. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2017-4-26 10:29 | 显示全部楼层
附上附件以供参考

1001260(By.Micro)V2.rar

52.35 KB, 下载次数: 4

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-4-26 18:16 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
microyip 发表于 2017-4-26 10:29
附上附件以供参考

micro老师,每次到这一步就不知道怎么办了,选择什么文件都不对(图片)。
QQ截图20170426181347.jpg

TA的精华主题

TA的得分主题

发表于 2017-4-26 18:54 | 显示全部楼层
skiss 发表于 2017-4-26 18:16
micro老师,每次到这一步就不知道怎么办了,选择什么文件都不对(图片)。

随便选一个文件
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 15:00 , Processed in 0.054217 second(s), 8 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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