请教数据汇总

quqiyuan

VBA参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet
    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    Set sh1 = wb.Sheets("血常规")
    Set sh2 = wb.Sheets("生化")
    Set sh3 = wb.Sheets("名单")
    Set sh4 = wb.Sheets("汇总")
    arr = sh1.[a1].CurrentRegion
    brr = sh2.[a1].CurrentRegion
    crr = sh3.[a1].CurrentRegion
    n = 0
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    ReDim drr(1 To UBound(crr) - 1, 1 To 100)
    For i = 2 To UBound(crr)
        d(crr(i, 1)) = i
    Next
    For i = 2 To UBound(arr)
        If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1)
        If Not d1.exists(arr(i, 2)) And arr(i, 2) <> Empty Then n = n + 1: d1(arr(i, 2)) = n
        If d.exists(Trim(arr(i, 1))) And arr(i, 2) <> Empty Then
            x = d(Trim(arr(i, 1))): y = d1(arr(i, 2))
            drr(x - 1, y) = arr(i, 3)
        End If
    Next
    For i = 2 To UBound(brr)
        If brr(i, 1) = Empty Then brr(i, 1) = brr(i - 1, 1)
        If Not d1.exists(brr(i, 2)) And brr(i, 2) <> Empty Then n = n + 1: d1(brr(i, 2)) = n
        If d.exists(Trim(brr(i, 1))) And brr(i, 2) <> Empty Then
            x = d(Trim(brr(i, 1))): y = d1(brr(i, 2))
            drr(x - 1, y) = brr(i, 3)
        End If
    Next
    With sh4
        .UsedRange.Clear
        .[a1].Resize(UBound(crr), UBound(crr, 2)) = crr
        .Cells(1, UBound(crr, 2) + 1).Resize(, n) = d1.keys
        .Cells(2, UBound(crr, 2) + 1).Resize(UBound(drr), n) = drr
        .UsedRange.Borders.LineStyle = 1
        .UsedRange.HorizontalAlignment = xlCenter
        .UsedRange.Columns.AutoFit
    End With
    Beep
    Set d = Nothing
    Set d1 = Nothing
    Application.ScreenUpdating = True
End Sub

mykitami

=LET(a,VSTACK(血常规!A2:C5000,生化!A2:C5000),b,FILTER(a,INDEX(a,,2)<>""),c,TRIM(SCAN(,TAKE(b,,1),LAMBDA(x,y,IF(y="",x,y)))),d,DROP(REDUCE("",c,LAMBDA(m,n,VSTACK(m,XLOOKUP(n,名单!A2:A11,名单!A2:E11)))),1),e,PIVOTBY(d,INDEX(b,,2),TAKE(b,,-1),SINGLE,0,0,,0,),HSTACK(VSTACK(A1:E1,DROP(TAKE(e,,5),1)),TAKE(e,,-6)))

lshn2015

1786024734 发表于 2024-10-12 15:54
F2=TRANSPOSE(VSTACK(OFFSET(血常规!$A$1,IFNA(MATCH(A2,TRIM(血常规!A:A),)-1,99),2,4),OFFSET(生化!$A$1, ...

谢谢老师，可以直接用

我要成为专家

1. =LET(s,VSTACK(血常规!$A$2:$C$33,生化!$A$2:$C$17),XLOOKUP($A2&F$1,TRIM(SCAN(,TAKE(s,,1),LAMBDA(x,y,IF(y="",x,y))))&CHOOSECOLS(s,2),TAKE(s,,-1),""))

复制代码

lshn2015

quqiyuan 发表于 2024-10-12 16:17
VBA参与一下，仅供参考。。。

体检数据汇总.rar (17 KB, 下载次数: 1)

2024-10-26 00:07 上传

点击文件名下载附件
有些改动

有些新问题，老师看看能不能帮忙解决，谢谢了

zlzz1971

=LET(s,HSTACK(SCAN("",VSTACK(血常规!A2:A33,生化!A2:A17),LAMBDA(x,y,IF(y="",x,TRIM(y)))),VSTACK(血常规!B2:B33,生化!B2:B17),VSTACK(血常规!C2:C33,生化!C2:C17)),IFNA(XLOOKUP(A2:A11&F1:K1,TAKE(s,,1)&CHOOSECOLS(s,2),TAKE(s,,-1)),""))