Excel如何利用VBA读取指定区域内非空单元格数据到另一个工作表中?结果如下图。

Question

如题所述

Answer 1

给你做好了，你只需要把数据区域改为你实际数据区域即可

Sub esit()
    Dim arr, brr, x%, y%, i%, j%, d As Object
    Set d = CreateObject("Scripting.Dictionary")
    j = Range("C65536").End(xlUp).Row
    arr = Range("B1:J" & j).Value
    ReDim brr(1 To UBound(arr, 2), -1 To 1)
    For x = 3 To UBound(arr)
        If arr(x, 1) = "" Then arr(x, 1) = arr(x - 1, 1)
        If arr(x, UBound(arr, 2)) <> "" Then
            i = i + 1
            d(arr(x, 1)) = d(arr(x, 1)) + 1
            ReDim Preserve brr(1 To UBound(arr, 2), -1 To i)
            For y = 1 To UBound(arr, 2)
                brr(y, i) = arr(x, y)
            Next y
        End If
    Next x
    For x = 1 To UBound(arr, 2)
        brr(x, -1) = arr(1, x)
        brr(x, 0) = arr(2, x)
    Next x
    Application.ScreenUpdating = False
    With Range("M1:U30")
        .ClearContents
        .Borders.LineStyle = 0
        .UnMerge
    End With
    Range("M1").Resize(i + 2, UBound(brr)) = Application.Transpose(brr)
    For x = 3 To i + 2
        If d(Cells(x, "M").Value) > 1 Then
            Application.DisplayAlerts = False
            Cells(x, "M").Resize(d(Cells(x, "M").Value), 1).Merge
            Application.DisplayAlerts = True
            x = x + d(Cells(x, "M"))
        End If
    Next x
    Range("M2").Resize(i + 1, UBound(brr)).Borders.LineStyle = 1
    Application.ScreenUpdating = True
End Sub

Answer 2

难点在于有合并单元格，如果第一个（如李一）为空，那么删除了就会缺少合并的科室（如后勤），建议如下逻辑处理：
一、全表复制
二、取消合并单元格，并把合并的值填充所有行
三、重新合并相同的科室

编程中如果还有问题请追问。本回答被网友采纳