数据如何自动导出？召唤大神“江南月”

luzeners

不好意思，没有说清楚，浪费时间和精力。十分抱歉！
导出结果有空行，是没有影响的。只要那行的数值结果。针对每一行，执行一次，一次输出从C7开始到后面所有单元格。
这是一个权限生成表：▲代表只读，√代表读写，        x代表无权限，不处理。
--------------
ICACLS D:\share\gdewpt-server\技术交流平台\61-CY80567\7-会议检讨交流 /GRANT test:(RX)
命令目的：给上述路径的用户：test授与只读权限

luzeners

非常抱谦，没有讲清楚。
浪费了时间和精力。
数据导出有空行，是没有问题的。
这是一个权限批量生成表格，最后生成的命令行，要拿到文件服务器上运行导入。
▲代表权限为只读
√代表权限为读写
x代表无权限，不处理
C7单元格的公式根据这三种符号来判断，再加上路径和对应的人员。
处理时要复制一整行到第五行生成对应路径的权限，然后把C7开始到后面的单元格数值导出到sheet4
手工复制粘贴导出数据基本不会出错，只是太费时间。

江南月

如果空行不影响的话,试一下下面的代码,就不发附件了,复制到你文件的vba模块里运行一下,我这边是通过了,就是结果里的空行比较多
Sub test01()
    Dim i As Integer, j As Integer, brr, sht1, sht2, rng
    Set sht1 = Sheets("sheet1")   '为了简化代码将表格定义给变量,可以根据实际情况改变括号内表格的名称
    Set sht2 = Sheets("Sheet4")
    sht2.UsedRange.Delete         '清空结果表中原有数据
    j = sht1.Cells(7, 256).End(1).Column    '获取统计区域sht1中第7行的最右侧非空单元格的列数

    For i = 1 To sht1.Range("A65536").End(3).Row - 7          '遍历数组arr
        sht1.Range("A5:CS5").Value = sht1.Cells(7 + i, 1).Resize(1, j).Value   '将第8行开始的数据依次复制到第5行
        
        brr = sht1.Cells(7, 3).Resize(1, j - 2).Value              '将第7行中要统计的数据装入数组brr
        
        Set rng = sht2.Range("A65536").End(3)                      '将sheet4表格中的最后一个非空单元格定义给变量rng
        
        If rng = "" Then                                           '对rng进行判断,如果系统默认的非空单元格A1为空
            rng.Resize(UBound(brr, 2), 1).Value = WorksheetFunction.Transpose(brr)     '则将brr数组转置后写入单元格A1开头的A列区域
        Else                                                                           '否则
            rng.Offset(1, 0).Resize(UBound(brr, 2), 1).Value = WorksheetFunction.Transpose(brr)   '将brr数组转置后装入A列最后一个非空单元格以后的区域
        End If
    Next
        
End Sub

江南月

下面的代码试一下,我这边没问题的,就是结果里有很多空行

Sub test01()
    Dim i As Integer, j As Integer, brr, sht1, sht2, rng
    Set sht1 = Sheets("sheet1")   '为了简化代码将表格定义给变量,可以根据实际情况改变括号内表格的名称
    Set sht2 = Sheets("Sheet4")
    sht2.UsedRange.Delete         '清空结果表中原有数据
    j = sht1.Cells(7, 256).End(1).Column    '获取统计区域sht1中第7行的最右侧非空单元格的列数

    For i = 1 To sht1.Range("A65536").End(3).Row - 7          '遍历数组arr
        sht1.Range("A5:CS5").Value = sht1.Cells(7 + i, 1).Resize(1, j).Value   '将第8行开始的数据依次复制到第5行
        
        brr = sht1.Cells(7, 3).Resize(1, j - 2).Value              '将第7行中要统计的数据装入数组brr
        
        Set rng = sht2.Range("A65536").End(3)                      '将sheet4表格中的最后一个非空单元格定义给变量rng
        
        If rng = "" Then                                           '对rng进行判断,如果系统默认的非空单元格A1为空
            rng.Resize(UBound(brr, 2), 1).Value = WorksheetFunction.Transpose(brr)     '则将brr数组转置后写入单元格A1开头的A列区域
        Else                                                                           '否则
            rng.Offset(1, 0).Resize(UBound(brr, 2), 1).Value = WorksheetFunction.Transpose(brr)   '将brr数组转置后装入A列最后一个非空单元格以后的区域
        End If
    Next
        
End Sub

luzeners

感谢！！！
可否告诉我，你那边的运行环境
我在虚拟机里的win7x64+office2003测试结果如下：

江南月

我是最新版的office365 E3一年试用版,系统64位win7

luzeners

江南月 发表于 2018-9-11 23:04
我是最新版的office365 E3一年试用版,系统64位win7

我试了好几个版本，都不行。
结果我用WPS2016的excel反而没有问题了！！！
谢谢你的付出！

江南月

江南月 发表于 2018-9-11 23:04
我是最新版的office365 E3一年试用版,系统64位win7

那就不清楚了,你说的情况,我从来没遇到过,也不用wps,我在别的电脑上也试过了,没有问题,真是很奇怪!