wxnxl 发表于
1.地址重复问题
这里是摸拟数据的时候，没摸拟好真实。当然不太可能这么多人的家庭地址都一样的是“村1” ...
你似乎没有回答我的问题。
分配时地址有关系么？
如果需要根据地址来分配，那么具体规则或限制条件是什么？
如果有要求，则需要上传真实数据……
你可以把姓名改为任意字母串，以防止信息泄露，
但地址可以采取真实的名称，以便准确模拟。
至多你可以把省或市或镇的名称改掉。其它部分则应该忠实保留，以便模拟测试效果。
在线时间4894 小时经验11876 威望9 性别女最后登录注册时间阅读权限95UID218774积分13476帖子精华1分享0
积分排行39帖子精华1微积分0
如果地址无关，则题目似乎应该很简单……一共32种不同的组合类型而已。
4个中学、2个性别、4个等级=4*2*4=32种分类。
在线时间148 小时经验169 威望0 性别男最后登录注册时间阅读权限20UID812396积分169帖子精华0分享2
EH初级, 积分 169, 距离下一级还需 181 积分
积分排行3000+帖子精华0微积分0
香川群子 发表于
你似乎没有回答我的问题。
分配时地址有关系么？
分配时地址只要查找关键字
比如，地址中有“东乡”二字的， 离三中比较近，所以分配到三中
其实有些地址我也不是清楚到底哪个更合理，所以需要临时调整的，只需要根据指定的关键字分配就好。
当满足了设置的地址关键字后，
至于找不到这些的地址了，就无所谓了，只要将人按计划比例（性别，等及）分完就好。
(75.85 KB, 下载次数: 3)
16:17 上传
下载次数: 3
我是来学习VBA的，如果我不小心帮助了你，请给我鼓励。
在线时间148 小时经验169 威望0 性别男最后登录注册时间阅读权限20UID812396积分169帖子精华0分享2
EH初级, 积分 169, 距离下一级还需 181 积分
积分排行3000+帖子精华0微积分0
不知道说清楚没有？
在线时间4894 小时经验11876 威望9 性别女最后登录注册时间阅读权限95UID218774积分13476帖子精华1分享0
积分排行39帖子精华1微积分0
本帖最后由 香川群子 于
13:49 编辑
不知道这样是否已满足要求：
注意，宏按钮是两用的。
按一次 清空G列结果，再按一次则计算、生成分配结果。如此反复。
13:49 上传
下载次数: 20
110.75 KB, 下载次数: 20
在线时间4894 小时经验11876 威望9 性别女最后登录注册时间阅读权限95UID218774积分13476帖子精华1分享0
积分排行39帖子精华1微积分0
程序算法原理说明：
1、首先统计学生的性别、等级，换算成分配表的列位置存入数组br
& &&&【男/女】以及【优/良/合格/不合格】 一共有8种，计算值=2-9对应cr中的第2-9列 (第1列为合计)
& && &并统计8种类别对应的学生总数，存入数组cr
2、接着根据M列中要求的分配比例，计算各校各等级的实际可分配人数存入数组cr
& & 8种类别对应的学生总数，在按各个学校的分配比例计算各校应该分配人数，使用Round()函数四舍五入取整数
& & 可能会产生总人数的累积误差，这个累积误差在第1所学校里进行对冲消化，保证总人数不变。
& & 同时使用字典把学校名称和学校序号联系起来，便于实际计算。
3、扣除F列手工分配人员信息(数组cr统计人数变化、数组ar1记录分配信息)
& &&&解释略& &
4、遍历E列，根据I列地址关键词优先分配(数组cr统计人数变化、数组ar1记录分配信息)
& &&&使用Instr()函数比对是否包含关键词。如含有则按规则直接分配。
& &&&注意为保证人数不超标，需要每次检查是否该学校有剩余名额可以分配。
5、剩余学生根据性别和等级、按顺序分配到各学校
& &&&所谓顺序，就是列表指定的学校顺序。本题为： 一中、二中、三中、四中的顺序。
6、在G列输出结果 (数组ar1信息)
7、按钮按一次清空G列，再按一次则生成分配信息。
8、Sheet2中用DCountA函数对结果进行了验证。
在线时间4894 小时经验11876 威望9 性别女最后登录注册时间阅读权限95UID218774积分13476帖子精华1分享0
积分排行39帖子精华1微积分0
代码供参考：Sub test()
& & Dim ar, ar0, ar1, ar2, dic, i&, j&, k&, m&, n&, n1&, n2&, s1$, s2$, t&, tms#
& & tms = Timer
& &
& & If Range(&g2&) && && Then Range(&g2:g65536&) = &&: Exit Sub
& &
& & m = Range(&b65536&).End(3).Row - 1
& & ar = Range(&c2&).Resize(m, 2)
& &
& & ReDim br&(1 To m)
& & ReDim cr1&(1 To 9)
& &
& & s1 = ChrW(22899)
& & 's1 = &女& '解释 Instr结果： 男=0, 女=1
& & s2 = ChrW(20248) & ChrW(33391) & ChrW(21512) & ChrW(26684)
& & 's2 = &优良合格&&&'解释 Instr结果： 优=1, 良=2, 合格=3, 不合格=0
& & For i = 1 To m
& && &&&n1 = InStr(s1, ar(i, 1))
& && &&&n2 = InStr(s2, ar(i, 2))
& && &&&j = n1 + IIf(n2, n2 * 2, 8)
& && &&&br(i) = j
& && &&&cr1(j) = cr1(j) + 1
& & Next
& &
& & n = Range(&l1&).End(4).Row - 2
& & ar0 = Range(&l2&).Resize(n, 2)
& &
& & Set dic = CreateObject(&Scripting.Dictionary&) '建立字典
& & For i = 1 To n
& && &&&dic(ar0(i, 1)) = i '使得 学校名的文字 可以通过字典对应序号
& & Next
& &
& & ReDim cr&(1 To n + 1, 1 To 9)
& & For j = 2 To 9
& && &&&For i = 1 To n
& && && && &cr(i, j) = Round(cr1(j) * ar0(i, 2), 0) '按比例计算应分配人数
& && && && &cr(n + 1, j) = cr(n + 1, j) + cr(i, j)
& && &&&Next
& && &&&cr(1, j) = cr(1, j) + cr1(j) - cr(n + 1, j) '在第1所学校中消化累积误差
& && &&&cr(n + 1, j) = cr1(j)
& & Next
& & For i = 1 To n + 1
& && &&&For j = 2 To 9
& && && && &cr(i, 1) = cr(i, 1) + cr(i, j) '统计各校总人数
& && &&&Next
& & Next
& & Range(&p2&).Resize(n + 1, 9) = cr '输出结果
& &
& & ar = Range(&e2&).Resize(m)
& & ar1 = Range(&f2&).Resize(m)
& & For i = 1 To m
& && &&&If ar1(i, 1) && && Then
& && && && &t = dic(ar1(i, 1))
& && && && &If cr(t, br(i)) & 0 Then
& && && && && & cr(t, br(i)) = cr(t, br(i)) - 1
& && && && &Else
& && && && && & MsgBox &Set Miss, Err!&
& && && && && & Exit Sub
& && && && &End If
& && &&&End If
& & Next
& &
& & k = Range(&i1&).End(4).Row - 1
& & ar2 = Range(&i2&).Resize(k, 3)
& & For i = 1 To k
'& && &&&ar2(i, 1) = &*& & ar2(i, 1) & &*&
& && &&&ar2(i, 3) = dic(ar2(i, 2))
& & Next
& &
& & For i = 1 To m
& && &&&If ar1(i, 1) = && Then
& && && && &For j = 1 To k
'& && && && && & If ar(i, 1) Like ar2(j, 1) Then
& && && && && & If InStr(ar(i, 1), ar2(j, 1)) Then
& && && && && && &&&t = ar2(j, 3)
& && && && && && &&&If cr(t, br(i)) & 0 Then
& && && && && && && && &cr(t, br(i)) = cr(t, br(i)) - 1
& && && && && && && && &ar1(i, 1) = ar2(j, 2)
& && && && && && && && &Exit For
& && && && && && &&&End If
& && && && && & End If
& && && && &Next
& && &&&End If
& & Next
'& & Range(&g2&).Resize(m) = ar1
& &
& & For i = 1 To m
& && &&&If ar1(i, 1) = && Then
& && && && &For t = 1 To n
& && && && && & If cr(t, br(i)) & 0 Then
& && && && && && &&&cr(t, br(i)) = cr(t, br(i)) - 1
& && && && && && &&&ar1(i, 1) = ar0(t, 1)
& && && && && && &&&Exit For
& && && && && & End If
& && && && &Next
& && &&&End If
& & Next
& &
& & MsgBox Format(Timer - tms, &0.000s&)
& & Range(&g2&).Resize(m) = ar1
End Sub复制代码
本帖评分记录鲜花
总评分:&鲜花 + 2&
在线时间148 小时经验169 威望0 性别男最后登录注册时间阅读权限20UID812396积分169帖子精华0分享2
EH初级, 积分 169, 距离下一级还需 181 积分
积分排行3000+帖子精华0微积分0
香川群子 发表于
代码供参考：
先谢谢！！！！！
果然是大神啊，收了我这个徒弟吧。。。。
慢慢研究学习中……希望能继续回复我的一些疑问，帮助我进步。
在线时间148 小时经验169 威望0 性别男最后登录注册时间阅读权限20UID812396积分169帖子精华0分享2
EH初级, 积分 169, 距离下一级还需 181 积分
积分排行3000+帖子精华0微积分0
本帖最后由 wxnxl 于
18:22 编辑
第1个问题：
s1 = ChrW(22899)
为什么不是 s1=&女“
是为了加快运行速度？
第2个问题：
& & m = Range(&b65536&).End(3).Row - 1
& & ar = Range(&c2&).Resize(m, 2)&&'将性别和等级列数据区域存入数组
& &&&ReDim br&(1 To m)
& & ReDim cr1&(1 To 9)
& &&&s1 = ChrW(22899)&&'女
& & s2 = ChrW(20248) & ChrW(33391) & ChrW(21512) & ChrW(26684)&&'优良合格
& & For i = 1 To m
& && &&&n1 = InStr(s1, ar(i, 1))
& && &&&n2 = InStr(s2, ar(i, 2))
& && &&&j = n1 + IIf(n2, n2 * 2, 8)
& && &&&br(i) = j
& && &&&cr1(j) = cr1(j) + 1
能否帮我注释一下这段红色的代码，特别是这一句& &&&j = n1 + IIf(n2, n2 * 2, 8)
我理解起来有点困难。看来是我应该再补一下关于数组的知识。
在线时间4894 小时经验11876 威望9 性别女最后登录注册时间阅读权限95UID218774积分13476帖子精华1分享0
积分排行39帖子精华1微积分0
s1 = ChrW(22899) 和 s1=&女“ 这两句代码是等效的。
差别在于，我的电脑不是中文环境，不能直接在代码中引用汉字。所以只能通过Unicode双位码来转换。
本帖评分记录鲜花
总评分:&鲜花 + 1&
积分≥4700即可申请
金牌优秀会员
金牌优秀会员奖章No.3
金牌优秀会员
金牌优秀会员奖章No.2
金牌优秀会员
金牌优秀会员奖章No.1
优秀会员奖章No.4
优秀会员奖章No.3
优秀会员奖章No.2
优秀会员奖章No.1
- 注意：自起，未完成邮箱认证的会员将无法发帖！如何完成邮箱认证？请点击下方“查看”。
关注我们，与您相约微信公众平台！
Copyright 1999 - 2017 Excel Home. All Rights Reserved.本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！
Powered by
本站特聘法律顾问：徐怀玉律师 李志群律师 &&[求助]求excel批量转换为txt文本，vba - ExcelHome技术论坛 - Powered by Discuz!
ExcelHome技术论坛
标题: [求助]求excel批量转换为txt文本，vba
作者: a& & 时间:
17:11 & & 标题: [求助]求excel批量转换为txt文本，vba
本帖最后由 a 于
17:15 编辑
求把附件里面的每行数据转换成每一个txt文本，每个字段逗号隔开。在线等啊。就是不知道VBA代码怎么写啊，哪个老师解决下把，万分感谢
效果表等等等
& && && && && && && && && && &&&vba老师们，哪个能帮我弄个嘛，可以加QQ
Sub Auto_Open()
& & Application.OnKey &^{P}&, &DaoChu&
Sub DaoChu()
&&Dim s As String, name As String
& & Dim i%, j%, irow%, icol%
& & Dim X As Integer
& & Dim FullName As String, rng As Range
& & irow = [a65536].End(xlUp).Row
& & icol = [iv3].End(xlToLeft).Column
& & For i = 2 To Sheet1.[a65536].End(xlUp).Row
& & Cells(i, 11) = CStr(Trim(Cells(i, 1))) & &,& & CStr(Trim(Cells(i, 2))) & &,& & CStr(Trim(Cells(i, 3))) & &,& & CStr(Trim(Cells(i, 4))) & &,& & CStr(Trim(Cells(i, 5))) & &,& & CStr(Trim(Cells(i, 6))) & &,& & CStr(Trim(Cells(i, 7))) & &,& & CStr(Trim(Cells(i, 8))) & &,& & CStr(Trim(Cells(i, 9))) & &,& & CStr(Trim(Cells(i, 10)))
& & Columns(&A:J&).Select
& & Selection.Delete Shift:=xlToLeft
& &' FullName = Replace(ThisWorkbook.FullName, &.xls&, &.txt&)
& &' Open FullName For Output As #1
& & For i = 1 To irow
& & For j = 1 To icol
& & s = s & Cells(i, j).Value & vbCrLf
& & RW = ActiveSheet.UsedRange.Rows.Count
& & For i = 1 To 1
& && &&&Open &C:\Users\think\Desktop\-& & Chr(Asc(&A&) + i - 1) & &Bank.txt& For Output As 1
& && && &&&For j = 1 To RW
& && && && && & Print #1, Range(Chr(Asc(&A&) + i - 1) & CStr(j)).Value
& && && && &Next j
& && &&&Close 1
& & Next i
& & MsgBox &数据导出完毕!&, vbOKOnly, &导出成功&
附件: [效果表] Desktop.rar ( 17:10, 308 Bytes) / 下载次数 13http://club.excelhome.net/forum.php?mod=attachment&aid=MTM4MzY0OHxjM2M0OTU0ZHwxNDE1MzE0NTU5fDB8MA%3D%3D附件: [原始表] abc.rar ( 17:09, 11.43 KB) / 下载次数 15http://club.excelhome.net/forum.php?mod=attachment&aid=MTM4MzY0NnxmMTQ4ZTU5NnwxNDE1MzE0NTU5fDB8MA%3D%3D
作者: a& & 时间:
本帖最后由 a 于
17:22 编辑
上面的代码只能导出到一个文本里面，哪位老师能帮忙改下吗？
这是上面代码导出的效果
2,5,1111,张三1,90,0,9
3,6,1112,张三2,91,1,8
*,& & *& &&&,& &*& & ,& &*& &,& &*& & ,& && &*& &,& && &*& && && && &&&,& &&&*& &,*,*
*,& & *& &&&,& &*& & ,& &*& &,& &*& & ,& && &*& &,& && &*& && && && &&&,& &&&*& &,*,*
*,& & *& &&&,& &*& & ,& &*& &,& &*& & ,& && &*& &,& && &*& && && && &&&,& &&&*& &,*,*
*,& & *& &&&,& &*& & ,& &*& &,& &*& & ,& && &*& &,& && &*& && && && &&&,& &&&*& &,*,*
*,& & *& &&&,& &*& & ,& &*& &,& &*& & ,& && &*& &,& && &*& && && && &&&,& &&&*& &,*,*
*,& & *& &&&,& &*& & ,& &*& &,& &*& & ,& && &*& &,& && &*& && && && &&&,& &&&*& &,*,*
作者: crazy0qwer& & 时间:
上面的代码只能导出到一个文本里面，哪位老师能帮忙改下吗？
这是上面代码导出的效果
2,5,1111 ...
导出当前表Sub 导出()
& & Dim FileName As String
& & FileName = Left(ThisWorkbook.FullName, InStr(ThisWorkbook.FullName, &.&) - 1)
& & ActiveSheet.Copy
& & ActiveWorkbook.SaveAs FileName, xlCSV
& & ActiveWindow.Close True
& & If Dir(FileName & &.txt&) && && Then Kill FileName & &.txt&
& & Name FileName & &.csv& As FileName & &.txt&
End Sub复制代码
作者: crazy0qwer& & 时间:
单行导出Sub 导出TXT()
& & Dim Ar, I As Long
& & Ar = [A1].CurrentRegion
& & For I = 2 To UBound(Ar)
& && &&&Open ThisWorkbook.Path & &\& & Ar(I, 5) & &.TXT& For Output As #1
& && && && &Print #1, Join(Application.Index(Ar, I), &,&)
& && &&&Close #1
& & Next
End Sub复制代码
作者: bluexuemei& & 时间:
crazy0qwer 发表于
导出当前表
txt文件中后面很多，，，，，，，，，这样的行，去掉就好了！
作者: crazy0qwer& & 时间:
bluexuemei 发表于
txt文件中后面很多，，，，，，，，，这样的行，去掉就好了！
那是因为这些多余的单元格有特殊字符或者其他格式，
转换的区域相当于 usedrange&&这个函数获得的区域，你可以用这句代码看看这个区域&&usedrange.select
你会发现选中的区域并不是你看到有数据的区域
如果要去掉这些可以把多余的区域删除即可
也可以先保存到数组，然后在cells.delete&&然后再赋值回去，
因为是不可见的字符，所以最好手动选择删除区域，否则用代码判断最后一行之类的方法可能会不准确。
Sub 导出()
& & Dim FileName As String
&&&&Rows(&12:65536&).Delete& &'删除多余行
& & Columns(&k:IV&).Delete& &'删除多余列
& & FileName = Left(ThisWorkbook.FullName, InStr(ThisWorkbook.FullName, &.&) - 1)
& & ActiveSheet.Copy
& & ActiveWorkbook.SaveAs FileName, xlCSV
& & ActiveWindow.Close True
& & If Dir(FileName & &.txt&) && && Then Kill FileName & &.txt&
& & Name FileName & &.csv& As FileName & &.txt&
作者: bluexuemei& & 时间:
crazy0qwer 发表于
那是因为这些多余的单元格有特殊字符或者其他格式，
转换的区域相当于 usedrange&&这个函数获得的区域， ...
多谢指点，谢谢！还有ActiveSheet.Copy这句改成ActiveSheet.usedrange.Copy,似乎程序运行不正常，工作表不见了，为什么？
作者: crazy0qwer& & 时间:
bluexuemei 发表于
多谢指点，谢谢！还有ActiveSheet.Copy这句改成ActiveSheet.usedrange.Copy,似乎程序运行不正常，工作表不 ...
没发现这个问题。就复制而已应该不会有什么问题。
作者: bluexuemei& & 时间:
crazy0qwer 发表于
没发现这个问题。就复制而已应该不会有什么问题。
你可以试一下，我试过N次都是这个问题，运行后，工作表不见了，代码窗口也不见了？why？
作者: crazy0qwer& & 时间:
bluexuemei 发表于
你可以试一下，我试过N次都是这个问题，运行后，工作表不见了，代码窗口也不见了？why？
我试过了，你把你代码发来看看，还有你是放模块还是哪个表里，
作者: bluexuemei& & 时间:
当然放模块里，就你的代码改一个地方
Sub 导出()
& & Dim FileName As String
& & FileName = Left(ThisWorkbook.FullName, InStr(ThisWorkbook.FullName, &.&) - 1)
& & ActiveSheet.usedrange.Copy
& & ActiveWorkbook.SaveAs FileName, xlCSV
& & ActiveWindow.Close True
& & If Dir(FileName & &.txt&) && && Then Kill FileName & &.txt&
& & Name FileName & &.csv& As FileName & &.txt&
作者: crazy0qwer& & 时间:
bluexuemei 发表于
当然放模块里，就你的代码改一个地方
Sub 导出()
& & Dim FileName As String
& & ActiveSheet.Copy&&这样是复制表，如果后面不指定位置的话 就是复制到新工作簿。所以我原代码执行这句话后，当前的工作簿是复制这个表产生的新工作簿，
而你用& & ActiveSheet.UsedRange.Copy 这样是复制单元格而已，并不会产生新工作簿，所以当前工作簿就是代码所在的工作簿，所以运行到后面的 Close 语句就把自己关闭了。
出问题你应该用F8单步调试看看。你这个问题，如果你单步调试看看我原来的程序和你改后的，你就可以看出区别了。
作者: bluexuemei& & 时间:
crazy0qwer 发表于
& & ActiveSheet.Copy&&这样是复制表，如果后面不指定位置的话 就是复制到新工作簿。所以我原代 ...
醍醐灌顶，多谢指教！
作者: a& & 时间:
crazy0qwer 发表于
导出当前表
非常感谢老师的指导，我自己的代码还是转换了在导出的显然麻烦了很多很多。小妹感谢感谢！
作者: a& & 时间:
bluexuemei 发表于
txt文件中后面很多，，，，，，，，，这样的行，去掉就好了！
我也看见了这个问题了，但是你没有发觉我的excel数据源是有问题的吗？打开看到第一行，第二行之间的间距很宽的呢，往下面拉就发现有八百多行呢，因为单元格不是默认的间距，vba代码自然会判定里面是有数据的，当然空值就出现所说的后面很多可多的逗号了。你尝试用格式刷，刷下后面的格式吧，我试过了刷了只有就没有了。
作者: a& & 时间:
crazy0qwer 发表于
那是因为这些多余的单元格有特殊字符或者其他格式，
转换的区域相当于 usedrange&&这个函数获得的区域， ...
虽然老师解释的很很很很专业，但是我还是要声明下是我数据，数据格式的问题，哈哈
我也看见了这个问题了，但是你没有发觉我的excel数据源是有问题的吗？打开看到第一行，第二行之间的间距很宽的呢，往下面拉就发现有八百多行呢，因为单元格不是默认的间距，vba代码自然会判定里面是有数据的，当然空值就出现所说的后面很多可多的逗号了。你尝试用格式刷，刷下后面的格式吧，我试过了刷了只有就没有了。
作者: crazy0qwer& & 时间:
虽然老师解释的很很很很专业，但是我还是要声明下是我数据，数据格式的问题，哈哈
我也看见了这个问题 ...
不能控制数据源吗？要从代码修正?
作者: a& & 时间:
本帖最后由 a 于
22:57 编辑
crazy0qwer 发表于
不能控制数据源吗？要从代码修正?
不知道哦，但是我发现是数据行之间的间距不是默认的时候就会判定为有值，
&&老师，另存为某个文件夹的代码是怎么写的哦
作者: crazy0qwer& & 时间:
不知道哦，但是我发现是数据行之间的间距不是默认的时候就会判定为有值，
&&老师，另存为某个文件夹的 ...
另存到指定的一个文件夹？修改代码的 FileName&&那句就好了
Sub 导出()
& & Dim FileName As String, Ar
& & FileName = Left(ThisWorkbook.FullName, InStr(ThisWorkbook.FullName, &.&) - 1)& &
& & 'filename=&D:\123\& & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, &.&) - 1) '指定路径，后面的文件名
& & ActiveSheet.Copy
& & Ar = ActiveSheet.UsedRange&&' 加上这三句话，按目前的格式是可以消除多余的逗号。
& & ActiveSheet.Cells.Delete
& & ActiveSheet.[A1].Resize(UBound(Ar), UBound(Ar, 2)) = Ar
& & ActiveWorkbook.SaveAs FileName, xlCSV
& & ActiveWindow.Close True
& & If Dir(FileName & &.txt&) && && Then Kill FileName & &.txt&
& & Name FileName & &.csv& As FileName & &.txt&
作者: a& & 时间:
crazy0qwer 发表于
另存到指定的一个文件夹？修改代码的 FileName&&那句就好了
Sub 导出()
& & Dim FileName As String, A ...
Sub Output_Onetext()
& &&&Dim Ar, I As Long
& &&&Ar = [A1].CurrentRegion
& &&&For I = 2 To UBound(Ar)
& && && &Open ThisWorkbook.Path & &\& & Ar(I, 4) & &.TXT& For Output As #1
& && && && &Print #1, Join(Application.Index(Ar, I), &,&)
& && &MsgBox &数据导出完毕!&, vbOKOnly, &导出成功&
老师，这段代码怎么写更改路径呢，是要存到指定的文件夹，怎么写的哦
作者: crazy0qwer& & 时间:
Sub Output_Onetext()
& &&&Dim Ar, I As Long
& &&&Ar = [A1].CurrentRegion
ThisWorkbook.Path&&这个就是路径了，改为你需要的路径就好了
注意 因为后面已经加了斜杠，所以你就不要在最后加斜杠了
还是写出来吧、
Open&&&D:\123\& & Ar(I, 4) & &.TXT& For Output As #1
作者: a& & 时间:
crazy0qwer 发表于
ThisWorkbook.Path&&这个就是路径了，改为你需要的路径就好了
注意 因为后面已经加了斜杠，所以你就不要 ...
Sub Output_Onetext()
& & Dim Ar, I As Long
& & Ar = [A1].CurrentRegion
& & For I = 2 To UBound(Ar)
& && &&&Open &C:\Users\think\Desktop\123\& & Ar(I, 1) & &.txt& For Output As #1
& && && &&&Print #1, Join(Application.Index(Ar, I), &,&)
& &&&MsgBox &数据导出完毕!&, vbOKOnly, &导出成功&
老师，在麻烦你下下，就是我不想在导出的文本里面导出A单元格里面的值该怎么控制哦
作者: crazy0qwer& & 时间:
Sub Output_Onetext()
& & Dim Ar, I As Long
& & Ar = [A1].CurrentRegionSub Output_Onetext()
& & Dim Ar, I As Long
& & Ar = Range([B2], Range(&J& & [E65536].End(3).Row))&&'B2 到J 列最后一行的区域
& & For I = 2 To UBound(Ar)
& && &&&Open &C:\Users\think\Desktop\123\& & Ar(I, 1) & &.txt& For Output As #1
& && && &&&Print #1, Join(Application.Index(Ar, I), &,&)
& && &&&Close
& & Next
& &&&MsgBox &数据导出完毕!&, vbOKOnly, &导出成功&
End Sub复制代码
作者: a& & 时间:
crazy0qwer 发表于
可以了但是，我b到J单元格的值有重复的值，导出的时候肯定会少一重复的数据，这个问题怎么解决呢，如果可以取A单元格中的值为txt的文件名，就不会少数据了，例（A单元格为序号）
作者: crazy0qwer& & 时间:
可以了但是，我b到J单元格的值有重复的值，导出的时候肯定会少一重复的数据，这个问题怎么解决呢，如果可 ...
Sub Output_Onetext()
& & Dim Ar, Ar1, I As Long
& & Ar = Range([B2], Range(&J& & [E65536].End(3).Row))
& & Ar1 = Columns(&A&)
& & For I = 2 To UBound(Ar)
& && &&&Open &C:\Users\think\Desktop\123\& & Ar1(I, 1) & &.txt& For Output As #1
& && && &&&Print #1, Join(Application.Index(Ar, I), &,&)
& && &&&Close
& &&&MsgBox &数据导出完毕!&, vbOKOnly, &导出成功&
作者: a& & 时间:
crazy0qwer 发表于
Sub Output_Onetext()
& & Dim Ar, Ar1, I As Long
& & Ar = Range(, Range(&J& & [E65536].End(3).Row ...
执行后第数据第一行数据不会被导出，如果把For I = 2 To UBound(Ar)换成For I = 1 To UBound(Ar)后会被导出但是，数据第一行会被放在最后且txt名字为字段名；
作者: crazy0qwer& & 时间:
执行后第数据第一行数据不会被导出，如果把For I = 2 To UBound(Ar)换成For I = 1 To UBound(Ar)后会被导 ...
你第一行不是字段吗，你把这行导出，文件名就是对应的A列的那个单元格啊。
你附件不一样，不懂你数据什么样。
作者: a& & 时间:
crazy0qwer 发表于
你第一行不是字段吗，你把这行导出，文件名就是对应的A列的那个单元格啊。
你附件不一样，不懂你数据什么 ...
你看导出的数据嘛，0行.txt里面的数据是excel里面的第二行，不知道老师能不能加我QQ附件: [数据表和导出的数据] Desktop.rar ( 17:07, 8.83 KB) / 下载次数 6http://club.excelhome.net/forum.php?mod=attachment&aid=MTM4NDI2MXw1ZjQxYTY3MHwxNDE1MzE0NTU5fDB8MA%3D%3D
作者: zhaogang1960& & 时间:
短信收到，请测试：Sub 宏1()
& & Dim arr, s$, i As Long, j As Integer
& & arr = [a1].CurrentRegion
& & For i = 2 To UBound(arr)
& && &&&s = arr(i, 1)
& && &&&For j = 2 To UBound(arr, 2)
& && && && &s = s & &,& & arr(i, j)
& && &&&Next
& && &&&Open ThisWorkbook.Path & &\123\& & i - 1 & &行.txt& For Output As #1
& && &&&Print #1, s
& && &&&Close
& & Next
& & MsgBox &导出完毕!&
End Sub复制代码
作者: zhaogang1960& & 时间:
(16.53 KB, 下载次数: 8)
15:36 上传
下载次数: 8
Desktop.rar ( 15:36, 16.53 KB) / 下载次数 8http://club.excelhome.net/forum.php?mod=attachment&aid=MTM4NDg2OXw3YTdlYTY5M3wxNDE1MzE0NTU5fDB8MA%3D%3D
欢迎光临 ExcelHome技术论坛 (http://club.excelhome.net/)
Powered by Discuz! X2