循环 Vlookup 到列 A 的最后一行,但每天 Vlookup 的起始单元格不同。

huangapple go评论67阅读模式
英文:

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(&quot;Balances&quot;).Activate

    If Range(&quot;C2&quot;).Value &gt; 0 Then             &#39;1st day of balances start in C2
        Range(&quot;C2&quot;).End(xlToRight).Offset(0, 1).Select
    Else
        Range(&quot;C2&quot;).Select
    End If

    If Sheets(&quot;Todays Bals&quot;).Range(&quot;A2&quot;) &lt;&gt; Sheets(&quot;Balances&quot;).Cells(1, ActiveCell.Column) Then
        MsgBox &quot;These balances are for a different day.  Please import the correct day&quot;
    Exit Sub
    Else
    
&#39;Above is fine
&#39;Below is where the issue is 

    LastRow = Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row
           
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 0).End(xlDown)).Offset(0, 0).Formula = _
    &quot;= vlookup(A2,&#39;Todays Bals&#39;!B:C,2,FALSE)&quot;
    
    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

循环 Vlookup 到列 A 的最后一行,但每天 Vlookup 的起始单元格不同。

英文:

A Multi VBA Lookup (Application.Match)

循环 Vlookup 到列 A 的最后一行,但每天 Vlookup 的起始单元格不同。

  • 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 of xlDown. 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()
    
    &#39; Define constants.
    
    Const SRC_SHEET As String = &quot;Todays Bals&quot;
    Const SRC_DATE_CELL As String = &quot;A2&quot;
    Const SRC_FIRST_ACCOUNTS_CELL As String = &quot;B5&quot; &#39; ?
    Const SRC_BALANCES_COLUMN As String = &quot;C&quot;
    
    Const DST_SHEET As String = &quot;Balances&quot;
    Const DST_DATE_FIRST_CELL As String = &quot;C1&quot;
    Const DST_FIRST_ACCOUNTS_CELL As String = &quot;A2&quot;
    
    Dim wb As Workbook: Set wb = ThisWorkbook &#39; workbook containing this code
    
    &#39; 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 &quot;The source date cell contains the invalid &quot;&quot;&quot; _
            &amp; CStr(sDate) &amp; &quot;&quot;&quot;.&quot;, 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 &lt; 1 Then
            MsgBox &quot;No accounts in worksheet &quot;&quot;&quot; &amp; SRC_SHEET &amp; &quot;&quot;&quot;.&quot;, vbCritical
            Exit Sub
        End If
        Set sarg = .Resize(srCount)
    End With
    
    Dim sbrg As Range: Set sbrg = sarg.EntireRow.Columns(SRC_BALANCES_COLUMN)
    
    &#39; 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 &lt; 1 Then
            MsgBox &quot;No dates in worksheet &quot;&quot;&quot; &amp; DST_SHEET &amp; &quot;&quot;&quot;.&quot;, 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 &quot;The date &quot;&quot;&quot; &amp; CStr(sDate) _
            &amp; &quot;&quot;&quot; was not found in worksheet &quot;&quot;&quot; &amp; DST_SHEET &amp; &quot;&quot;&quot;.&quot;, _
            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 &quot;The second accounts cell &quot;&quot;&quot; &amp; .Address(0, 0) _
                    &amp; &quot;&quot;&quot; can&#39;t be empty.&quot;, 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)
    
    &#39; 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)) &gt; 0 Then &#39; is not blank
            srIndex = Application.Match(dValue, sarg, 0)
            If IsNumeric(srIndex) Then &#39; match found in source range row
                dbrg.Cells(dr).Value = sbrg.Cells(srIndex).Value
            End If
        End If
    Next dCell
        
    &#39; Inform.
        
    MsgBox &quot;Account balances copied.&quot;, vbInformation

End Sub

huangapple
  • 本文由 发表于 2023年7月10日 19:34:35
  • 转载请务必保留本文链接:https://go.coder-hub.com/76653328.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定