麦草草 发表于 2021-9-24 07:54:00

根据身份证横向提取不重复的采样日期

根据身份证横向提取不重复的采样日期，或者提取不重复的采样日期及相应的结果

落葉去無痕 发表于 2021-10-23 00:15:41

=IFERROR(INDEX(Sheet1!$W$4:$W$31,SMALL(IF(Sheet1!$G$4:$G$31=$H3,ROW($1:$28),10^8),COLUMN(A1))),"")用一对多套路公式 数组三键横拉下拉 数据量大建议其他方式。

幸福像花儿 发表于 2021-11-2 16:06:15

Sub 统计()
Dim arr, brr, crr()
Dim r, m, i, j, k, t, s
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheet1
r = .Cells(.Rows.Count, 5).End(xlUp).Row
arr = .Range("E4:W" & r)
End With
For i = 1 To UBound(arr)
   s = arr(i, 1) & "/" & arr(i, 3)
   If Not d.exists(s) Then
    m = 1
    ReDim brr(1 To 1, 1 To m)
Else
    brr = d(s)
    m = UBound(brr, 2) + 1
    ReDim Preserve brr(1 To 1, 1 To m)
End If
brr(1, m) = arr(i, 19)
d(s) = brr
Next
k = d.keys
t = d.items
ReDim Preserve crr(1 To d.Count, 1 To 7)
For j = 0 To d.Count - 1
crr(j + 1, 1) = Split(k(j), "/")(0)
crr(j + 1, 2) = Split(k(j), "/")(1)
For i = 1 To UBound(t(j), 2)
    crr(j + 1, i + 3) = t(j)(1, i)
Next
Next
Sheet2.Range("G3:M65536") = ""
Sheet2.Range("G3").Resize(UBound(crr), UBound(crr, 2)) = crr
Set d = Nothing
End Sub

用户健康祥和 发表于 2021-11-19 18:32:29

面包蟹 发表于 2021-11-25 04:25:24

=TRANSPOSE(FILTER(Sheet1!$W$4:$W$31,(Sheet1!$E$4:$E$31=Sheet2!G3)*(Sheet1!$G$4:$G$31=Sheet2!H3)))

心随海 发表于 2021-12-15 04:17:14

附表2的名字是固定的，不一定是附表1的名字。所以不能清空，为什么数据多了 就用不了

雨中淋淋 发表于 2021-12-19 14:23:12

J3
采样时间升序
=IFERROR(INDEX(Sheet1!$W$4:$W$31,MATCH(,COUNTIF($I3:I3,Sheet1!$W$4:$W$31)/(Sheet1!$G$4:$G$31=$H3),)),"")
右拉下拉
采样时间乱序
=IFERROR(SMALL(IF(FREQUENCY((Sheet1!$G$4:$G$31=$H3)*Sheet1!$W$4:$W$31,(Sheet1!$G$4:$G$31=$H3)*Sheet1!$W$4:$W$31)*((Sheet1!$G$4:$G$32=$H3)*Sheet1!$W$4:$W$32>0),(Sheet1!$G$4:$G$32=$H3)*Sheet1!$W$4:$W$32,""),COLUMN(A:A)),"")
右拉下拉

東郊飛龍 发表于 2021-12-29 20:04:02

Option Base 1
Private Sub CommandButton1_Click()
Dim dicI As New Dictionary
Dim dicN As New Dictionary
Dim arr, brr()
Dim A&, I&, J&
With Worksheets(1)
A = .Range("G50000").End(xlUp).Row - 3
arr = .Range("E4").Resize(A, 19)
End With
ReDim brr(A, A)
For I = 1 To A
If Not dicI.Exists(arr(I, 3)) Then
    J = J + 1
    dicI(arr(I, 3)) = J
    brr(dicI(arr(I, 3)), 1) = arr(I, 1)
    brr(dicI(arr(I, 3)), 2) = arr(I, 3)
    dicN(arr(I, 3)) = 3
End If
dicN(arr(I, 3)) = dicN(arr(I, 3)) + 1
brr(dicI(arr(I, 3)), dicN(arr(I, 3))) = arr(I, 19)
Next
Worksheets(2).Range("G3").Resize(J, WorksheetFunction.Max(dicN.Items())) = brr
End Sub
页: [1]
查看完整版本: 根据身份证横向提取不重复的采样日期