[已解决][求助] 请老师邦助修改宏,谢谢

xhcyi · 发表于 2012-5-23 01:31

提示: 作者被禁止或删除内容自动屏蔽

zjdh · 发表于 2012-5-23 13:08

Sub Macro1()
Dim wj As String
Range("A2:U65536").ClearContents
wj = Dir(ThisWorkbook.Path & "\*.txt")
s = 0: s1 = 1
Do While wj <> ""
s = s + 1
s2 = 0
Open ThisWorkbook.Path & "\" & wj For Input As #s
Do While Not (EOF(s))
      Line Input #s, n
      s2 = s2 + 1
      If s2 > 0 Then
         s1 = s1 + 1
         y = Split(n, ",")
         For i = 0 To UBound(y)
            Cells(s1, i + 1) = y(i)
            Cells(s1, 21) = Right(wj, 12)
         Next i
      End If
Loop
Close #s
wj = Dir
Loop
End Sub

zjdh · 发表于 2012-5-23 13:44

消除空行数据：
Sub Macro1()
Dim wj As String
Range("A2:L65536").ClearContents
wj = Dir(ThisWorkbook.Path & "\*.txt")
s = 0: S1 = 1
Do While wj <> ""
s = s + 1
s2 = 0
Open ThisWorkbook.Path & "\" & wj For Input As #s
Do While Not (EOF(s))
      Line Input #s, n
      s2 = s2 + 1
      If s2 > 1 Then
         Y = Split(n, ",")
         If UBound(Y) > 1 Then    '非空行
            S1 = S1 + 1
            For i = 0 To UBound(Y)
            Cells(S1, i + 1) = Y(i)
            Cells(s1, 21) = Right(wj, 12)
            Next i
         End If
      End If
Loop
Close #s
wj = Dir
Loop
End Sub

xhcyi · 发表于 2012-5-23 19:31

提示: 作者被禁止或删除内容自动屏蔽

xhcyi · 发表于 2012-5-23 19:38

提示: 作者被禁止或删除内容自动屏蔽

zjdh · 发表于 2012-5-24 07:44

本帖最后由 zjdh 于 2012-5-24 07:48 编辑

Sub Macro1()
Dim wj As String
Range("A2:U65536").ClearContents
wj = Dir(ThisWorkbook.Path & "\*.txt")
s = 0: S1 = 1
Do While wj <> ""
      s = s + 1
      s2 = 0
      Open ThisWorkbook.Path & "\" & wj For Input As #s
      Do While Not (EOF(s))
         Line Input #s, n
         s2 = s2 + 1
         If s2 > 0 Then
            Y = Split(n, ",")
            S1 = S1 + 1
            For i = 0 To UBound(Y)
                  Cells(S1, i + 1) = Y(i)
                  Cells(S1, 21) = Replace(Split(wj, ".")(0), ThisWorkbook.Path, "")
            Next i
         End If
      Loop
      Close #s
      wj = Dir
Loop
End Sub

		自动登录	找回密码
密码			注册

xhcyi xhcyi 当前离线积分 178 IP卡狗仔卡	发表于 2012-5-23 01:31 \| 显示全部楼层 \|阅读模式工作中常用的Excel函数公式，全印在一张超大鼠标垫上提示: 作者被禁止或删除内容自动屏蔽
xhcyi xhcyi 当前离线积分 178 IP卡狗仔卡
	回复使用道具举报提升卡置顶卡沉默卡喧嚣卡变色卡抢沙发千斤顶显身卡
	工作中最常用的函数公式，全印在一张超大的鼠标垫上

xhcyi xhcyi 当前离线积分 178 IP卡狗仔卡	楼主\| 发表于 2012-5-23 19:31 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽
xhcyi xhcyi 当前离线积分 178 IP卡狗仔卡
	回复使用道具举报显身卡

xhcyi xhcyi 当前离线积分 178 IP卡狗仔卡	楼主\| 发表于 2012-5-23 19:38 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽
xhcyi xhcyi 当前离线积分 178 IP卡狗仔卡
	回复使用道具举报显身卡