excel - VBA 查找和替换行条目
问题描述
我正在尝试编写一个基本上执行以下操作的函数:
- 从工作簿 #1 中获取“名称”单元格值
- 从工作簿 #1 中获取“数量”单元格值
- 打开第二个工作簿(这是一个 2 列列表,其中 columnA = "Names" 和 columnB = "Amounts")
- 扫描第二个工作簿的 A 列以查找重复的“名称”条目(来自步骤 1)
- 如果存在重复,则使用步骤 2 中存储的值覆盖 B 列中相应的“金额”值
- 如果不存在重复,则将新的最后一行附加到列表中
- 在第二个工作簿的 A 列的最后一行写入“名称”
- 在第二个工作簿的 B 列的最后一行写入“金额”
本质上,此函数将更新名称列表及其相应数量。如果列表中已存在名称,则此脚本将在 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 行开始。
如果你在某个地方卡住了,请告诉我,以便我们解决。否则,请提供工作簿示例以调整代码。
推荐阅读
- django - Django ckeditor - 将宽度设置为 100%
- reactjs - 在本机反应中增加 AsyncStorage 大小限制
- php - mysql查询到数组
- ios - 我可以更改我的应用在默认 iOS 共享表中的位置吗?
- antlr4 - ANTLR:如何使用 ANTLR 4 根据索引位置解析固定长度的文本文件?
- python - 如何从fabric2组中获取正在处理的主机
- vue.js - 发出 Axios 请求时加载微调器
- javascript - 单击时保持元素突出显示
- javascript - 路由模块在 APP_INITIALIZER 之前加载
- mysql - 如何在 SQL 表中找到所有可能的组合?