导出表不含空白列

hhxq001

A1233515 发表于 2021-4-14 17:04
把代码倒数第二句（close那句）去掉

去掉这句后，原表自动关闭了，打开的是新表呢，我要求是原表开着，新表不打开

hhxq001

A1233515 发表于 2021-4-14 17:05
另，由于代码是在原数据表基础上修改的，所以如果自己关闭工作表时，一定要不保存

我修改了保存路径，现在就是无法实现保存关闭新表，旧表打开着
导出0414-关闭新表打开旧表.rar (44.52 KB, 下载次数: 1)

2021-4-14 20:45 上传

点击文件名下载附件

A1233515

修改了一下，再试试

A1233515

另外，还是要注意，关闭原工作表时，一定要不保存

wang-way

经测试 黄色的表头 并不是空单元格  定位空值部分定位不到

hhxq001

wang-way 发表于 2021-4-15 09:19
经测试 黄色的表头 并不是空单元格  定位空值部分定位不到

朋友可以给注解一下吗？

hhxq001

A1233515 发表于 2021-4-15 08:57
修改了一下，再试试

你还是没有明白我的意思：要求原来的表继续打开着，不做任何改动，而新表要求是没有打开状态。

hhxq001

wang-way 发表于 2021-4-15 09:19
经测试 黄色的表头 并不是空单元格  定位空值部分定位不到

用你的代码我只能删除J-M空列后面的空列删除不了

donghui2363

练习练习
Sub 导出()
Dim rng As Range, wk As Workbook
Set d = CreateObject("scripting.dictionary")
Set fso = CreateObject("scripting.filesystemobject")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
p = ThisWorkbook.Path & "\"
fso.copyfile p & ThisWorkbook.Name, p & "副本.xlsm"
    Set wk = Workbooks.Open(p & "副本.xlsm")
    With wk.Sheets(1)
        arr = .UsedRange
        For j = 1 To UBound(arr, 2)
            If arr(3, j) = "" Then
                d(j) = ""
            End If
        Next j
        For Each k In d.keys
            If rng Is Nothing Then
                Set rng = Columns(k)
            Else
                Set rng = Union(rng, Columns(k))
            End If
        Next
        rng.EntireColumn.Delete
        wk.Save
        wk.Close
    End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

donghui2363

你试试试试试试试试