Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3569|回复: 13

[已解决]大师们帮忙看看编程

[复制链接]
发表于 2015-3-19 08:49 | 显示全部楼层 |阅读模式
怎样修改编程可以达到sheet1不发生变化,链接仍然存在,谢谢。
Sub test()
Dim arr1, arr2
Dim x, y, h As Long
    On Error Resume Next
    flag = False
    wf = Application.GetSaveAsFilename("")
    If wf = False Then Exit Sub
    If Dir(wf) <> "" Then
        If MsgBox("目标文件已存在,是否替换?", vbYesNo, "询问") = vbYes Then
            flag = True
        End If
    Else
        flag = True
    End If
    If flag Then
        arr1 = Range("d1:g90")
        ReDim arr2(1 To 90, 1 To 4)
        For x = 1 To 90
          If Len(arr1(x, 1) & arr1(x, 2) & arr1(x, 3)) > 0 Then
            h = h + 1
            For y = 1 To 4
              arr2(h, y) = arr1(x, y)
            Next
          End If
        Next
        Cells.ClearContents
        [d1].Resize(h, 4) = arr2
        Range("d1:g90").Copy
        Workbooks.Add
        ActiveSheet.Paste
        ActiveWorkbook.SaveAs Filename:=wf & "xls"
        ActiveWorkbook.Close True
        Application.DisplayAlerts = True
    End If
    [d1].Resize(90, 4) = arr1
    MsgBox "OK"
End Sub
最佳答案
2015-3-19 16:06
(, 下载次数: 3)

20150319.zip

11.37 KB, 下载次数: 6

发表于 2015-3-19 10:53 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2015-3-19 11:08 | 显示全部楼层
zjdh 发表于 2015-3-19 10:53
表1中不存在“链接”啊!

有啊,看看图,谢谢
20150319.png
回复

使用道具 举报

发表于 2015-3-19 13:16 | 显示全部楼层
20150319.rar (10.99 KB, 下载次数: 3)
回复

使用道具 举报

 楼主| 发表于 2015-3-19 13:28 | 显示全部楼层
zjdh 发表于 2015-3-19 13:16

但是这样,保存结果里sheet1中的空白行就去不掉了,我是想把空白行同时去掉,请问怎样改,谢谢
回复

使用道具 举报

发表于 2015-3-19 13:34 | 显示全部楼层
本帖最后由 zjdh 于 2015-3-19 13:37 编辑

还有啥要求一并说出来!你原来没提到空行的事。
回复

使用道具 举报

发表于 2015-3-19 13:40 | 显示全部楼层
是保存的文件不要“链接”吗?
回复

使用道具 举报

 楼主| 发表于 2015-3-19 14:15 | 显示全部楼层
zjdh 发表于 2015-3-19 13:40
是保存的文件不要“链接”吗?

是原来的文件保留链接,保存的文件去掉链接,然后名称,数值1,数值2 为空值的去掉相应的行,谢谢
回复

使用道具 举报

 楼主| 发表于 2015-3-19 14:16 | 显示全部楼层
zjdh 发表于 2015-3-19 13:40
是保存的文件不要“链接”吗?

最好格式可以保留,谢谢
回复

使用道具 举报

发表于 2015-3-19 14:38 | 显示全部楼层
20150319-2.rar (11.95 KB, 下载次数: 2)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 13:47 , Processed in 1.322943 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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