关于数据模板自动导入汇总表里..........

MrXU

本人VBA是个小白，请哪位老师帮帮忙。谢谢...........

3190496160

Sub luru()
ar = Array([b2], [b3], [b4], [b5], [b6], [d2], [d3], [d4], [d5], [d6], [f2], [f3], [f4], [f5], [f6])
With Sheets("Sheet1")
     r = .Cells(Rows.Count, 1).End(xlUp).Row + 1
     .Cells(r, 1).Resize(1, UBound(ar) + 1) = ar
End With
MsgBox "ok!"
End Sub

3190496160

1.rar (18.12 KB, 下载次数: 20)

2024-5-21 15:13 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br(), i&, j&, r&
   
    Application.ScreenUpdating = False
   
    With [A1].CurrentRegion
        ar = Intersect(.Offset(), .Offset(1)).Value
        For i = 2 To UBound(ar, 2) Step 2
            r = r + 1
            ReDim Preserve br(1 To r)
            br(r) = Application.Index(ar, , i)
        Next i
    End With
    ReDim ar(1 To UBound(ar) * r)
   
    r = 0
    For j = 1 To UBound(br)
        For i = 1 To UBound(br(j))
            r = r + 1
            ar(r) = br(j)(i, 1)
        Next i
    Next j
   
    With Sheets(1)
        If .Cells(2, 2) = "" Then r = 2 Else r = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(r, 1).Resize(, UBound(ar)) = ar
    End With

    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

...............

Qs18

Sub test()
Dim i, j, k, col, m
With Sheet1
    If .Range("a2") = "" Then
        m = 2
    Else
        m = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    End If
    For i = 2 To 6 Step 2
        k = 2
        Do While Sheet2.Cells(k, i) <> ""
            col = col + 1
            .Cells(m, col) = Sheet2.Cells(k, i)
        k = k + 1
        Loop
    Next
End With
MsgBox "录入完成！"
End Sub

MrXU

Qs18 发表于 2024-5-21 19:56
Sub test()
Dim i, j, k, col, m
With Sheet1

哪行代码是代表录入哪个单元格内容的

MrXU

gwjkkkkk 发表于 2024-5-21 19:15
Option Explicit
Sub TEST2()
    Dim ar, br(), i&, j&, r&

如果要更改表格结构，怎么确定要保存哪个单元格内容

MrXU

gwjkkkkk 发表于 2024-5-21 19:15
Option Explicit
Sub TEST2()
    Dim ar, br(), i&, j&, r&

怎么确定哪个单元格内容是保存的，因为我要更改表格结构

ykcbf1100

MrXU 发表于 2024-5-22 07:30
怎么确定哪个单元格内容是保存的，因为我要更改表格结构

送花再问比较合适。