我正在尝试编写一个基本上执行以下操作的函数:
本质上,此函数将更新名称列表及其相应数量。如果列表中已存在名称,则此脚本将在 A 列中查找重复条目,并更新同一行 B 列中的关联金额。如果此列表中不存在名称,该函数将向列表中添加一个新行,然后将存储的“名称”值写入 A 列,并将存储的“金额”值写入 B 列。
我已经完成了步骤 1-3,但是在为 4-8 创建循环时遇到了一些麻烦。这是我目前拥有的代码......任何帮助将不胜感激!
谢谢!
Sub Open_Updator()
Dim proj_name As String
Dim amount As Double
Dim updator As Workbook
Dim updator_sheet As Worksheet
Dim LastRow As Long
Dim arr() As Variant
Dim R As Long
Dim C As Long
Dim Destination As Range
proj_name_raw = ThisWorkbook.Sheets("Cover").Range("C7").Value
proj_name = Left(proj_name_raw, Len(proj_name_raw) - 3)
amount = ThisWorkbook.Sheets("Summary").Range("O110").Value
Set updator = Workbooks.Open(Filename:="C:\Users\XXXXX\Desktop\updator.xlsx")
updator.Activate
Set updator_sheet = Sheets("Table")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
arr = Range("A1:B" & LastRow)
Set Destination = Range("A1")
For R = 1 To UBound(arr, 1)
For C = 1 To UBound(arr, 2)
If arr(R, C) = proj_name Then arr(R, C) = arr(R, 1)
Next C
Next R
Destination.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub
谢谢!
最佳答案
好的。尝试这个:
Private Sub Test()
Dim WB1 As Worksheet
Set WB1 = Workbooks.Open(Filename:="WB1.xlsx").Sheets("Sheet1")
Dim LastRow As Long
Dim LastRowWB1 As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastRowWB1 = WB1.Cells(Rows.Count, "A").End(xlUp).Row
j = 1
For r = 2 To LastRowWB1
Name = WB1.Cells(r, "A").Value
For x = 2 To LastRow + j
If Cells(x, "A").Value = Name Then
Cells(x, "B") = WB1.Cells(r, "B")
Exit For
ElseIf Cells(x, "A") = "" Then
Cells((LastRow + j), "A") = WB1.Cells(r, "A").Value
Cells((LastRow + j), "B") = WB1.Cells(r, "B").Value
j = j + 1
End If
Next x
Next r
End Sub
您还可以使用查找:
Private Sub Test2()
Dim WB1 As Worksheet
Set WB1 = Workbooks.Open(Filename:="U:\Temp\WB1.xlsx").Sheets("Sheet1")
Dim LastRow As Long
Dim LastCol As Long
Dim SrchInArray As Range
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastRowWB1 = WB1.Cells(Rows.Count, "A").End(xlUp).Row
j = 1
Set SrchInArray = Range(Cells(2, "A"), Cells(LastRow, "A"))
For r = 2 To LastRowWB1
Name = WB1.Cells(r, "A").Value
Set y = SrchInArray.Find(WB1.Cells(r, "A").Value, , xlValues, xlWhole, xlByRows, xlNext, False, False, False)
If Not y Is Nothing Then
Cells(y.Row, "B") = WB1.Cells(r, "B").Value
Else
Cells(LastRow + j, "A") = WB1.Cells(r, "A").Value
Cells(LastRow + j, "B") = WB1.Cells(r, "B").Value
j = j + 1
End If
Next r
End Sub
您将不得不调整一些名称。该代码假定两个工作簿中的第 1 行都有标签,名称和值从第 2 行开始。
如果你在某个地方卡住了,请告诉我,以便我们解决。否则,请提供工作簿示例以调整代码。
关于excel - VBA 查找和替换行条目,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/59268235/