英文:
Loop Vlookup to LastRow of Column A, but vlookup starts in a different cell each day
问题
我是VBA的新手,这是我的第一篇帖子。我已经搜索过了,但似乎找不到与我的情况匹配且不使用设置范围的内容。
我有一个工作表,其中在第一列(列A)中保存了一列账户号码(没有空白单元格),在顶部行中保存了日期。每天,用户都会从银行下载余额报告并将其导入到此宏中。
我希望该宏能够在我的列表中(工作表名称为“Balances”)查找列A中的帐户,并从导入的列表中(工作表名称为“Todays Bals” - 帐户在列B中,余额在列C中)返回每个帐户的余额。
我试图让该宏从顶部数据行(第2行)的下一个空单元格开始进行vlookup,直到帐户列表的底部,但它会越过最后一个非空单元格,并覆盖底部的合计(显示为#N/A),这些合计已经准备好等待vlookup完成(帐户列表之间有一个空行)。
我认为我可能在代码中矛盾了LastRow和activecell,但我不知道如何修复它。
非常感谢您的帮助。
以下是我目前的代码:
Sub Vlookup()
Dim LastRow As Long
Worksheets("Balances").Activate
If Range("C2").Value > 0 Then '1st day of balances start in C2
Range("C2").End(xlToRight).Offset(0, 1).Select
Else
Range("C2").Select
End If
If Sheets("Todays Bals").Range("A2") <> Sheets("Balances").Cells(1, ActiveCell.Column) Then
MsgBox "These balances are for a different day. Please import the correct day"
Exit Sub
Else
'上面的部分没有问题
'下面的部分是有问题的地方
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0).End(xlDown)).Offset(0, 0).Formula = _
"=VLOOKUP(A2,'Todays Bals'!B:C,2,FALSE)"
End If
End Sub
英文:
I'm a newbie to VBA and this is my first post. I've searched but can't seem to find anything that matches my scenario without using set ranges.
I have a worksheet that holds a list of account numbers in column A (no blank cells in between) and dates across the top row. Each day the user downloads a balances report from the bank and imports it in to this macro.
I want the macro to vlookup the accounts that are in column A of my list (sheetname is Balances) and return the balances for each account from the imported list (sheetname is Todays Bals - Account is Col B and Balance is Col C).
I'm trying to get a vlookup to work from the next empty cell in the top data row (row 2) to the bottom of the account list but it's going past the last non-empty cell and overwriting totals (with #N/A) that are at the bottom of the sheet, formulated ready for when the vlookup is completed for that day. (The totals have a blank row in between the list of accounts).
I think I may have contradicted the lastrow and activecell in the code, but I don't know how to fix it.
Any help is appreciated.
Below is my code so far:
Sub Vlookup()
Dim LastRow As Long
Worksheets("Balances").Activate
If Range("C2").Value > 0 Then '1st day of balances start in C2
Range("C2").End(xlToRight).Offset(0, 1).Select
Else
Range("C2").Select
End If
If Sheets("Todays Bals").Range("A2") <> Sheets("Balances").Cells(1, ActiveCell.Column) Then
MsgBox "These balances are for a different day. Please import the correct day"
Exit Sub
Else
'Above is fine
'Below is where the issue is
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0).End(xlDown)).Offset(0, 0).Formula = _
"= vlookup(A2,'Todays Bals'!B:C,2,FALSE)"
End If
End Sub
答案1
得分: 1
多重VBA查找(Application.Match
)
- 为了不进一步复杂化问题(例如使用Find方法),我使用了奇怪的条件,即目标中的单元格
A3
不能是空的,以确保xlDown
的成功。假定在账户和总计行之间有一个空行。 - 另外,我没有使用数组或字典,以保持简单(嗯!?)。
Sub CopyAccountBalances()
' 定义常量。
Const SRC_SHEET As String = "Todays Bals"
Const SRC_DATE_CELL As String = "A2"
Const SRC_FIRST_ACCOUNTS_CELL As String = "B5" ' ?
Const SRC_BALANCES_COLUMN As String = "C"
Const DST_SHEET As String = "Balances"
Const DST_DATE_FIRST_CELL As String = "C1"
Const DST_FIRST_ACCOUNTS_CELL As String = "A2"
Dim wb As Workbook: Set wb = ThisWorkbook ' 包含此代码的工作簿
' 源
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim sDate: sDate = sws.Range(SRC_DATE_CELL).Value
If Not IsDate(sDate) Then
MsgBox "源日期单元格包含无效的" & CStr(sDate) & "。", vbCritical
Exit Sub
End If
Dim sarg As Range, srCount As Long
With sws.Range(SRC_FIRST_ACCOUNTS_CELL)
srCount = sws.Cells(sws.Rows.Count, .Column).End(xlUp).Row - .Row + 1
If srCount < 1 Then
MsgBox "工作表" & SRC_SHEET & "中没有账户。", vbCritical
Exit Sub
End If
Set sarg = .Resize(srCount)
End With
Dim sbrg As Range: Set sbrg = sarg.EntireRow.Columns(SRC_BALANCES_COLUMN)
' 目标
Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
Dim ddrg As Range, dcCount As Long
With dws.Range(DST_DATE_FIRST_CELL)
dcCount = dws.Cells(.Row, sws.Columns.Count).End(xlToLeft).Column _
- .Column + 1
If dcCount < 1 Then
MsgBox "工作表" & DST_SHEET & "中没有日期。", vbCritical
Exit Sub
End If
Set ddrg = .Resize(, dcCount)
End With
Dim dDateColumnIndex:
dDateColumnIndex = Application.Match(CLng(sDate), ddrg, 0)
If IsError(dDateColumnIndex) Then
MsgBox "日期" & CStr(sDate) _
& "在工作表" & DST_SHEET & "中未找到。", _
vbCritical
Exit Sub
End If
Dim darg As Range, drCount As Long
With dws.Range(DST_FIRST_ACCOUNTS_CELL)
With .Offset(1)
If IsEmpty(.Value) Then
MsgBox "第二个账户单元格" & .Address(0, 0) _
& "不能是空的。", vbCritical
Exit Sub
End If
End With
drCount = .End(xlDown).Row - .Row + 1
Set darg = .Resize(drCount)
End With
Dim dbrg As Range: Set dbrg = darg.EntireRow _
.Columns(ddrg.Cells(dDateColumnIndex).Column)
' 查找
Dim dCell As Range, dValue, srIndex, dr As Long
For Each dCell In darg.Cells
dr = dr + 1
dValue = dCell.Value
If Len(CStr(dValue)) > 0 Then ' 不为空
srIndex = Application.Match(dValue, sarg, 0)
If IsNumeric(srIndex) Then ' 在源范围行中找到匹配项
dbrg.Cells(dr).Value = sbrg.Cells(srIndex).Value
End If
End If
Next dCell
' 通知。
MsgBox "账户余额已复制。", vbInformation
End Sub
英文:
A Multi VBA Lookup (Application.Match
)
- To not further complicate matters (e.g. by using the Find method), I have used the strange condition that cell
A3
in the destination can't be empty to ensure the success ofxlDown
. It is assumed that there is an empty row between the accounts and the totals row. - Also, I haven't used arrays or a dictionary to keep it simple (hmm!?).
<!-- language: lang-vb -->
Sub CopyAccountBalances()
' Define constants.
Const SRC_SHEET As String = "Todays Bals"
Const SRC_DATE_CELL As String = "A2"
Const SRC_FIRST_ACCOUNTS_CELL As String = "B5" ' ?
Const SRC_BALANCES_COLUMN As String = "C"
Const DST_SHEET As String = "Balances"
Const DST_DATE_FIRST_CELL As String = "C1"
Const DST_FIRST_ACCOUNTS_CELL As String = "A2"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim sDate: sDate = sws.Range(SRC_DATE_CELL).Value
If Not IsDate(sDate) Then
MsgBox "The source date cell contains the invalid """ _
& CStr(sDate) & """.", vbCritical
Exit Sub
End If
Dim sarg As Range, srCount As Long
With sws.Range(SRC_FIRST_ACCOUNTS_CELL)
srCount = sws.Cells(sws.Rows.Count, .Column).End(xlUp).Row - .Row + 1
If srCount < 1 Then
MsgBox "No accounts in worksheet """ & SRC_SHEET & """.", vbCritical
Exit Sub
End If
Set sarg = .Resize(srCount)
End With
Dim sbrg As Range: Set sbrg = sarg.EntireRow.Columns(SRC_BALANCES_COLUMN)
' Destination
Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
Dim ddrg As Range, dcCount As Long
With dws.Range(DST_DATE_FIRST_CELL)
dcCount = dws.Cells(.Row, sws.Columns.Count).End(xlToLeft).Column _
- .Column + 1
If dcCount < 1 Then
MsgBox "No dates in worksheet """ & DST_SHEET & """.", vbCritical
Exit Sub
End If
Set ddrg = .Resize(, dcCount)
End With
Dim dDateColumnIndex:
dDateColumnIndex = Application.Match(CLng(sDate), ddrg, 0)
If IsError(dDateColumnIndex) Then
MsgBox "The date """ & CStr(sDate) _
& """ was not found in worksheet """ & DST_SHEET & """.", _
vbCritical
Exit Sub
End If
Dim darg As Range, drCount As Long
With dws.Range(DST_FIRST_ACCOUNTS_CELL)
With .Offset(1)
If IsEmpty(.Value) Then
MsgBox "The second accounts cell """ & .Address(0, 0) _
& """ can't be empty.", vbCritical
Exit Sub
End If
End With
drCount = .End(xlDown).Row - .Row + 1
Set darg = .Resize(drCount)
End With
Dim dbrg As Range: Set dbrg = darg.EntireRow _
.Columns(ddrg.Cells(dDateColumnIndex).Column)
' The Lookup
Dim dCell As Range, dValue, srIndex, dr As Long
For Each dCell In darg.Cells
dr = dr + 1
dValue = dCell.Value
If Len(CStr(dValue)) > 0 Then ' is not blank
srIndex = Application.Match(dValue, sarg, 0)
If IsNumeric(srIndex) Then ' match found in source range row
dbrg.Cells(dr).Value = sbrg.Cells(srIndex).Value
End If
End If
Next dCell
' Inform.
MsgBox "Account balances copied.", vbInformation
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论