VBA--实例1.1--多表单据汇总

实例

多表单据汇总

目标	excel中多表单据中特定cell中的内容汇总成数据条。
demo分解	usedrange的首个非空的单元格定位 实时更新的数据清除
文件	不知怎们上传demo文件知道的留言一下
技术思辨	循环定位range方式： 方式1：可以是cell()的变量变化。 方式2：也可以是offset()的偏移。多用于range的整体偏移。

代码1需要清空数据

Sub subroutine1()
    Dim r, c As String
    r = 4   '确定编辑的首行信息
    Rows(r & ":" & 65536).Delete    '清空数据
    
    Dim sht As Variant
    For Each sht In Sheets  '剔除总表每个表的循环
        If sht.CodeName <> "Sheet2" Then
            Dim ct As Integer
            Dim i As Variant
            ct = Range("b2:d2").Count
            Cells(r, 1).Value = sht.Name
            For i = 2 To ct + 1 '单元格对应循环复制
                Sheet2.Cells(r, i).Value = sht.Range(Cells(2, i).Value).Value
            Next i
            r = r + 1
        End If
    Next sht
End Sub

代码2 数据需要紧接着编辑

Sub subroutine2()
    Dim r As String
    r = Range("a65536").End(xlUp).Row   '不清空数据确定需编辑的首行
    
    Dim sht As Variant
    Dim rng As Range
    For Each sht In Sheets '每个表的循环
        If sht.CodeName <> "Sheet2" Then
            Set rng = Cells(r, 1) '选择目标对象
            Set rng = rng.Offset(1, 0)
            Dim arr() As Variant
            Dim i As Variant
            arr = Range("b2:d2").Value
            rng.Value = sht.Name
            For Each i In arr
                Set rng = rng.Offset(0, 1)  '通过偏移得到目标
                rng.Value = sht.Range(i).Value
            Next i
            r = r + 1
        End If
    Next sht
End Sub