把不规律数据写入另一张工作表

爱疯

图1




图2



可能常常碰到这样的情况：将多个无规律的单元格（见图1），依次写入到某个工作表（见图2）。
因此，从求助中选了几例，希望能对类似需求的朋友有所帮助。




最后的更新在 2 楼

爱疯

http://www.excelpx.com/thread-417520-1-1.html
'例1：对比自己的表格，只改颜色部分。
Sub test1()
    Dim Source As Worksheet
    Dim Destination As Worksheet
    Dim lastRow As Long

    '1）设置变量
    Set Source = Sheets("A")    '指定源工作表
    Set Destination = Sheets("B")    '指定目标工作表
    lastRow = Destination.Cells(Rows.Count, "A").End(xlup).Row + 1    '获取目标工作表最后一行的行号

    '2）进行赋值
    Destination.Cells(lastRow, "A").Value = Source.[J3].Value
    Destination.Cells(lastRow, "B").Value = Source.[B3].Value
    Destination.Cells(lastRow, "C").Value = Source.[B4].Value
    Destination.Cells(lastRow, "D").Value = Source.[B5].Value
    Destination.Cells(lastRow, "E").Value = Source.[J4].Value
    '还有就加
    Destination.Select    '可选
End Sub




http://www.excelpx.com/thread-373474-1-1.html
'例2：是对例1简化，将指定的各个位置依次存入数组arr，再一次输出。
Sub test2()
    Dim arr(1 To 1, 1 To 99) As String
    Dim rng As Range
    Dim j As Integer

    '1）存入
    For Each rng In Sheets(2).Range("b16,b3,d3,f3,b6,h3,c6,d6,e6,d16,f16,b14")
        j = j + 1
        arr(1, j) = rng
        'rng = ""    '可选
    Next

    '2）输出
    With Sheets(1)
        .Cells(.Cells(Rows.Count, 1).End(3).Row + 1, 1).Resize(1, j) = arr
        .Activate    '可选
    End With
End Sub




http://www.excelpx.com/thread-338298-1-1.html
'例3：多行多列的情况
Sub test3()
    Dim A, B(1 To 6, 1 To 9), i, j, s, r
    A = Sheets(1).Range("a5").CurrentRegion
    r = Sheets(2).Cells(Rows.Count, 2).End(3).Row

    For i = 6 To 11
        '检查源表的多行多列区域，本行是否有空单元格
        For j = 2 To 6
            If A(i, j) = "" Then Exit For
        Next j
        '如果数据齐全，才添加
        If j = 7 Then
            s = s + 1
            B(s, 1) = r - 1 + s '在本例中，减1是为求序号的值
            B(s, 2) = A(3, 7)
            B(s, 3) = A(4, 7)
            '源表b:g，目标d:i，是连续对应的
            For j = 4 To UBound(B, 2)
                B(s, j) = A(i, j - 2)
            Next j
        End If
    Next i

    With Sheets(2)
        .Activate
        .Cells(r + 1, 1).Resize(UBound(B), UBound(B, 2)) = B
    End With
End Sub

落叶飘零731104

代码1的情况是在保存后执行的吗？有时候会出现空格，没有数据，怎么设置可以填写空值过去

爱疯

落叶飘零731104 发表于 2016-5-21 21:33
代码1的情况是在保存后执行的吗？有时候会出现空格，没有数据，怎么设置可以填写空值过去

如果和你的需求不同，还是在你自己的帖子里上传excel文档，以便其它朋友帮你想办法。。。

落叶飘零731104

哦，我可以一个一个的试试，谢谢老师！！

落叶飘零731104

老师，不好意思，方式1，看懂了，可是我方式3，我没有看懂呢。我是表1打印一次，就填充一行，方式3是多行多列，可是我没看懂呢，能有那位老师再说仔细点吗。

allenyzhan

爱疯 发表于 2015-12-16 10:29
http://www.excelpx.com/thread-417520-1-1.html
'例1：对比自己的表格，只改颜色部分。
Sub test1()

lastRow = Destination.Cells(Rows.Count, "A").End(xlup).Row + 1
这句里面加入destination运行不了啊，而且也无法理解，去掉destination反而可以正常运行呢 。

yonhe

学习了!

liuym

下载学习学习。