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

麦草草

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

新建 XLSX 工作表.rar (10.02 KB, 下载次数: 33)

2021-9-24 07:54 上传

点击文件名下载附件
新建 XLSX 工作表.rar

落葉去無痕

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

幸福像花儿

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

用户健康祥和

统计次数.rar (21.39 KB, 下载次数: 18)

2021-9-24 07:54 上传

点击文件名下载附件
统计次数.rar

面包蟹

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

心随海

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

雨中淋淋

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)),"")
右拉下拉

東郊飛龍

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