當前位置:成語大全網 - 新華字典 - 期待VBA高手來看看,EXCEL表中如何提取數據表中各姓名的到某個截止日期的最新數據?要VBA代碼。

期待VBA高手來看看,EXCEL表中如何提取數據表中各姓名的到某個截止日期的最新數據?要VBA代碼。

妳的趙六也出現了的呀,16不是趙六嗎?

給妳來個字典和動態數組,單元格事件的,就是在F1輸入完截止日期,回車自動運行的

Private Sub Worksheet_Change(ByVal Target As Range)

Dim x&, i&

Dim t1 As Date

Dim arr, arr1()

Dim d

Set d = CreateObject("scripting.dictionary")

If Target.Address = "$F$1" Then

t1 = Target.Value

With Sheets("原始數據表")

arr = .Range("A2:D" & .Range("A65536").End(xlUp).Row).Value

End With

For x = UBound(arr) To 1 Step -1

If Not d.exists(arr(x, 2)) And arr(x, 4) <= t1 Then

i = i + 1

d.Add arr(x, 2), ""

ReDim Preserve arr1(1 To 4, 0 To i)

For k = 1 To 4

arr1(k, i) = arr(x, k)

Next k

End If

Next x

For i = 1 To UBound(arr1, 2) - 1

For j = i + 1 To UBound(arr1, 2)

If arr1(1, i) > arr1(1, j) Then

For l = 1 To 4

t = arr1(l, i)

arr1(l, i) = arr1(l, j)

arr1(l, j) = t

Next l

End If

Next j

Next i

arr1(1, 0) = "序號"

arr1(2, 0) = "姓名"

arr1(3, 0) = "數據"

arr1(4, 0) = "更新日期"

Range("A:D").ClearContents

Range("A1").Resize(UBound(arr1, 2) + 1, 4) = Application.Transpose(arr1)

End If

End Sub

速度很快了。