[已解决]跪求各位大大们帮忙做一个宏 好人一生平安 抱拳了老铁

冥王

mai998 发表于 2015-1-16 14:34
运行错误啊

我这里Win 7系统   Excel2010运行正常

mai998

冥王 发表于 2015-1-16 14:47
我这里Win 7系统   Excel2010运行正常

.....我的是2007 麻烦给转一下格式好不好?

附件上传了能不能给直接做到附件上啊  谢谢了  

ppp710715

mai998 发表于 2015-1-16 14:47
谢谢 老大  我的附件已上传

请测试
附件2.rar (7.11 KB, 下载次数: 4)

2015-1-16 14:57 上传

点击文件名下载附件

mai998

ppp710715 发表于 2015-1-16 14:58
请测试

老大  这个就是个空的excel  没有任何宏啊   按钮也没呢

ppp710715

mai998 发表于 2015-1-16 15:01
老大  这个就是个空的excel  没有任何宏啊   按钮也没呢

附件2.rar (10.21 KB, 下载次数: 3)

2015-1-16 15:18 上传

点击文件名下载附件
已重新上传。

mai998

ppp710715 发表于 2015-1-16 15:19
已重新上传。

还是空的啊  ......  我的是 2007

mai998

各位大大们 急需啊 跪求啊

ppp710715

2007版的可以打开2003的呀！
打开后，按按钮就行。
也可按Alt+F11打开VBE，直接运行程序。

冥王

mai998 发表于 2015-1-16 16:55
各位大大们 急需啊 跪求啊

这是不是你要的？突然感觉有些不太明白，可能是误解了题意。。。。。

mai998

ppp710715 发表于 2015-1-16 16:59
2007版的可以打开2003的呀！
打开后，按按钮就行。
也可按Alt+F11打开VBE，直接运行程序。

我点了按钮了啊 可是没反应啊  alt+f11   你看看是不是这个代码
Private Sub CommandButton21_Click()
    rw = Cells(Rows.Count, 2).End(3).Row
    brr = Range("a1:a" & rw)
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    arr = Range("a1:b" & rw)
    For i = 1 To UBound(arr)
      k = arr(i, 1)
      If i = 1 Then
100:  Open ThisWorkbook.Path & k & ".txt" For Append As #2
      Print #2, arr(i, 2)
      ElseIf arr(i, 1) = arr(i - 1, 1) Then
        Print #2, arr(i, 2)
       Else
       Close #2
       GoTo 100
      End If
    Next
    Close #2
    [a1].Resize(rw) = brr
    MsgBox "操作完毕！"
End Sub