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

江南月

Sub test()
    Dim i As Integer, rng As Range, arr, sht1 As Worksheet, sht4 As Worksheet
    Set sht1 = Sheets("sheet1")   '为了简化代码将表格定义给变量,可以根据实际情况改变括号内表格的名称
    Set sht4 = Sheets("Sheet4")
    Sheets("Sheet4").UsedRange.Delete  '清空结果表中原有数据
    arr = sht1.Range("A8:B" & sht1.Range("A1048576").End(3).Row).Value   '将要依次复制到第5行的单元格区域数据装入数组arr,可以根据实际修改表格区域
   
    For i = 1 To UBound(arr, 1)                                '遍历数组
   
        sht1.Cells(5, 1).Value = arr(i, 1)                     '将数组中第二维的第1个元素赋值给A5单元格,可以根据实际进行单元格位置的修改,下同
        
        sht1.Cells(5, 2).Value = arr(i, 2)                     '将数组中第二维的第2个元素赋值给B5单元格
        
        Set rng = sht4.Range("A1048576").End(3)                '将sheet4表格中的最后一个非空单元格定义给变量rng
        
        If rng = "" Then                                       '队rng进行判断,如果系统默认的非空单元格A1为空
        
            rng.Value = sht1.Cells(7, 3).Value                 '则将sheet1表格中的C7单元格的值赋给Sheet4表中的A1单元格
            
            rng.Offset(1, 0).Value = sht1.Cells(7, 4).Value    '将sheet1表格中的D7单元格的值赋给Sheet4表中的A2单元格
            
        Else                                                   '如果rng为A1以外最后一个非空单元格
        
           rng.Offset(1, 0).Value = sht1.Cells(7, 3).Value     '则将sheet1表格中的C7单元格的值赋给rng下面第1行的单元格
           
           rng.Offset(2, 0).Value = sht1.Cells(7, 4).Value     '将sheet1表格中的D7单元格的值赋给rng下面第2行的单元格
        End If
    Next
   
   
End Sub

江南月

看看能不能打开,不太清楚你后面发的附件的具体变化的意义,你根据注释看着修改一下吧

luzeners

江南月 发表于 2018-9-8 16:59
Sub test()
    Dim i As Integer, rng As Range, arr, sht1 As Worksheet, sht4 As Worksheet
    Set s ...

谢谢回复！
你给出的命令能处理C7,D7数据，E7后面可能还有50-90个单位格的数据。还需要加一个定义范围的判断语句，我这样理解对吗？

江南月

D7后面的单元格也要同时输入到结果表里吗?如果是那样的话,就要重新组织一下代码了

江南月

改了一下,看看能不能符合你的预期

luzeners

大神附档里面没有看到宏代码？是不是遗漏了？
非常感谢你的热心回复！

江南月

这个我检查过了,程序在模块里

luzeners

江南月 发表于 2018-9-9 18:02
这个我检查过了,程序在模块里

非常感谢！
只是宏执行时中断了，有一行代码不能通过。

江南月

如果是在我发的附件文件里运行,是不应该有问题的,如果用在别的文件里,你数据的位置有变动的话,出现问题很正常,代码注释里都说了,要根据实际位置进行修改的
[图片]

江南月

这是我电脑运行的截图