gpt4 book ai didi

excel - 获取最近截止日期的相应值

转载 作者:行者123 更新时间:2023-12-02 01:24:12 25 4
gpt4 key购买 nike

enter image description here

如上图所示:
我需要在某些条件下将 Wb1.coumns(1) 上的值与其他工作簿 Wb2.coumns(1) 进行匹配。
Wb2 将过滤 M 列中的值 Close
然后,我查找最新的截止日期并在 B 列中获取其各自的值,并将该值输入到 Wb1.column(K) 中。
下面的代码可以正确地处理所提供的示例,但它在我的实际数据集上并不可靠,因为它取决于许多列从最旧到最新的排序。
这是link for the provided sample

  Sub Get_the_respective_value_of_Last_Closing_Date()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim arr1() As Variant, arr2() As Variant

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("Path of wb2", UpdateLinks:=False, ReadOnly:=True)

Set ws1 = wb1.Sheets(1)
Set ws2 = wb2.Sheets(1)

Set rng1 = ws1.Range("A3:K" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row) 'Main Range
Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)

arr1 = rng1.Value2
arr2 = rng2.Value2

Dim i As Long, k As Long
For i = LBound(arr1) To UBound(arr1)
For k = LBound(arr2) To UBound(arr2)

If arr1(i, 1) = arr2(k, 1) And arr2(k, 13) = "Close" Then
rng1.Cells(i, 11) = arr2(k, 2)
End If

Next k
Next i

wb2.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

最佳答案

请尝试下一个改编的代码。它使用字典来保留打开的工作簿的唯一 kay(以及“K:K”中的最后一个值作为项目),然后将适当的数据放入工作工作簿中:

Sub Get_Last_Closing_Date()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim arr1() As Variant, arr2() As Variant
Dim dict As Object

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
'Please, update the real path of "Book2.xlsx":
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx", UpdateLinks:=False, ReadOnly:=True)

Set ws1 = wb1.Sheets(1)
Set ws2 = wb2.Sheets(1)

Set rng1 = ws1.Range("A3:K" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row) 'Main Range
Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)

arr1 = rng1.Value2
arr2 = rng2.Value2

'place the unique last key in a dictionary:
Dim i As Long
Set dict = CreateObject("Scripting.dictionary")
For i = 1 To UBound(arr2)
If arr2(i, 13) = "Close" Then
dict(arr2(i, 1)) = arr2(i, 2)
End If
Next i
Debug.Print Join(dict.items, "|") 'just to visualy see the result

'Place the necessary data in its place:
For i = 1 To UBound(arr1)
If dict.Exists(arr1(i, 1)) Then
arr1(i, 11) = dict(arr1(i, 1))
Else
arr1(i, 11) = "NA"
End If
Next i

rng1.Value2 = arr1 'drop back the updated array content

wb2.Close SaveChanges:=False

Application.ScreenUpdating = True
MsgBox "Ready..."
End Sub

要打开的工作簿的“K:K”列必须按升序排序...

已编辑:

下一个版本无需对“K:K”列进行排序即可工作:

Sub Get_Last_Closing_Date()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim arr1() As Variant, arr2() As Variant
Dim dict As Object

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx", UpdateLinks:=False, ReadOnly:=True)

Set ws1 = wb1.Sheets(1)
Set ws2 = wb2.Sheets(1)

Set rng1 = ws1.Range("A3:K" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row) 'Main Range
Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)

arr1 = rng1.Value2
arr2 = rng2.Value2

'place the unique last key in a dictionary:
Dim i As Long
Set dict = CreateObject("Scripting.dictionary")
For i = 1 To UBound(arr2)
If arr2(i, 13) = "Close" Then
If Not dict.Exists(arr2(i, 1)) Then
dict(arr2(i, 1)) = Array(arr2(i, 2), arr2(i, 11)) 'place the date from K:K, too
Else
If CDate(arr2(i, 11)) > CDate(dict(arr2(i, 1))(1)) Then 'change the item only in case of a more recent date:
dict(arr2(i, 1)) = Array(arr2(i, 2), arr2(i, 11))
End If
End If
End If
Next i

'Place the necessary data in its place:
For i = 1 To UBound(arr1)
If dict.Exists(arr1(i, 1)) Then
arr1(i, 11) = dict(arr1(i, 1))(0) 'extract first item array element
Else
arr1(i, 11) = "NA"
End If
Next i

rng1.Value2 = arr1 'drop back the updated array content

wb2.Close SaveChanges:=False

Application.ScreenUpdating = True
MsgBox "Ready..."
End Sub

关于excel - 获取最近截止日期的相应值,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/75181219/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com