Look for values from sheet A in sheet B, and then

2019-09-10 09:46发布

I need to ook for values from sheet A in sheet B, and then do function in corresponding sheet B cell in VBA so I can change the data in worksheet 1, press a button, and have it work. The Letter headings denote the name of the rows in excel. The xs are just saying that it is data I do not want to manipulate. I have sheet 1 and sheet 2.

 Worksheet 1                        
H     I            J          K          L           M          N
1   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    100     xxxxxxxx
2   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    200     xxxxxxxx
3   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    300     xxxxxxxx
4   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    400     xxxxxxxx
5   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    500     xxxxxxxx
6   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    600     xxxxxxxx
7   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    700     xxxxxxxx
8   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    800     xxxxxxxx
9   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    900     xxxxxxxx
10  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1000    xxxxxxxx
11  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1100    xxxxxxxx
12  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1200    xxxxxxxx
13  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1300    xxxxxxxx
14  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1400    xxxxxxxx
15  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1500    xxxxxxxx
16  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1600    xxxxxxxx
17  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1700    xxxxxxxx
18  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1800    xxxxxxxx
19  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1900    xxxxxxxx
20  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    2000    xxxxxxxx

Worksheet 2                     
   H        I         J           K           L         M     N
   2    xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    25  xxxxxxxx
   5    xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    40  xxxxxxxx
   9    xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    35  xxxxxxxx
  11    xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    50  xxxxxxxx
  10    xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    65  xxxxxxxx
   6    xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    90  xxxxxxxx
   7    xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    10  xxxxxxxx

So that the corresponding values are subtracted in worksheet 1, thus changing the values of the M column.

Worksheet 1 - new                   
H     I            J          K          L           M          N
1   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    100     xxxxxxxx
2   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    175     xxxxxxxx
3   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    300     xxxxxxxx
4   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    400     xxxxxxxx
5   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    460     xxxxxxxx
6   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    510     xxxxxxxx
7   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    690     xxxxxxxx
8   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    800     xxxxxxxx
9   xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    865     xxxxxxxx
10  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    935     xxxxxxxx
11  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1050    xxxxxxxx
12  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1200    xxxxxxxx
13  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1300    xxxxxxxx
14  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1400    xxxxxxxx
15  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1500    xxxxxxxx
16  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1600    xxxxxxxx
17  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1700    xxxxxxxx
18  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1800    xxxxxxxx
19  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    1900    xxxxxxxx
20  xxxxxxxx    xxxxxxxx    xxxxxxxx    xxxxxxxx    2000    xxxxxxxx

3条回答
手持菜刀,她持情操
2楼-- · 2019-09-10 10:10

With acknowledgements to Gary's Student's answer, this is a variation on the theme which (a) uses the Range.Find method to find the account and (b) allows you to set the columns (and other setup parameters) as you have requested. Accordingly, set the various parameters to suit your scenario. Note both my sets of test data were positioned to start in A1 and Company/Expense/Account were side-by-side ie. Offsets of 1.

Option Explicit
Sub subExp()
Dim wsExp As Worksheet, wsAcc As Worksheet
Dim accRng As Range, fndCo As Range, c As Range
Dim expStRow As Long, expEndRow As Long, expCoCol As Long, expExpColOffset As Long
Dim accStRow As Long, accEndRow As Long, accCoCol As Long, accAcColOffset As Long

'Assign worksheets
Set wsExp = Worksheets("Expenses")
Set wsAcc = Worksheets("Accounts")

'Assign data start position on each sheet
expStRow = 2
expCoCol = 1
expExpColOffset = 1
accStRow = 2
accCoCol = 1
accAcColOffset = 1

    With wsAcc
        accEndRow = .Cells(Rows.Count, accCoCol).End(xlUp).Row
        Set accRng = .Range(.Cells(accStRow, accCoCol), .Cells(accEndRow, accCoCol).Offset(0, accAcColOffset))
    End With

    With wsExp
        expEndRow = .Cells(Rows.Count, expCoCol).End(xlUp).Row
        Set expRng = .Range(.Cells(expStRow, expCoCol), .Cells(expEndRow, expCoCol))
            For Each c In expRng
                Set fndCo = accRng.Find(What:=c, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
                If Not fndCo Is Nothing Then
                    fndCo.Offset(0, accAcColOffset).Value = fndCo.Offset(0, accAcColOffset).Value - c.Offset(0, expExpColOffset).Value
                End If
            Next c
    End With
End Sub
查看更多
Rolldiameter
3楼-- · 2019-09-10 10:21

As an alternative to avoid a loop:

Sub tgr()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rngH1 As Range, rngM1 As Range
    Dim rngH2 As Range, rngM2 As Range
    Dim arrResults As Variant

    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set rngH1 = ws1.Range("H2", ws1.Cells(Rows.Count, "H").End(xlUp))
    Set rngM1 = Intersect(rngH1.EntireRow, ws1.Columns("M"))

    Set ws2 = ActiveWorkbook.Sheets("Sheet2")
    Set rngH2 = ws2.Range("H2", ws2.Cells(Rows.Count, "H").End(xlUp))
    Set rngM2 = Intersect(rngH2.EntireRow, ws2.Columns("M"))

    arrResults = Evaluate("=INDEX(" & rngM1.Address(External:=True) & "-SUMIF(" & rngH2.Address(External:=True) & "," & rngH1.Address(External:=True) & "," & rngM2.Address(External:=True) & "),)")

    rngM1.Value = arrResults

End Sub
查看更多
何必那么认真
4楼-- · 2019-09-10 10:27

This will perform the update to the values on Sheet B

Sub New2VBA()
    Dim A As Worksheet, B As Worksheet
    Dim i As Long, j As Long, v As Variant
    Dim N As Long, M As Long
    Set A = Sheets("Sheet A")
    Set B = Sheets("Sheet B")
    N = A.Cells(Rows.Count, "A").End(xlUp).Row
    M = B.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 1 To N
        v1 = A.Cells(i, "A").Value
        v2 = A.Cells(i, "B").Value
        For j = 1 To M
            If v1 = B.Cells(j, "A").Value Then
                B.Cells(j, "B").Value = B.Cells(j, "B").Value - v2
                Exit For
            End If
        Next j
    Next i
End Sub

EDIT#1:

Here is the updated code.....remove the old code:

This will update the values on sheet A (your worksheet 1) based on the delta values on sheet B (2)

Sub New2VBA()
    Dim A As Worksheet, B As Worksheet
    Dim i As Long, j As Long, v As Variant
    Dim N As Long, M As Long
    Set A = Sheets("Sheet A")
    Set B = Sheets("Sheet B")
    '
    '   A is worksheet 1
    '   B is worksheet 2
    '
    N = A.Cells(Rows.Count, "H").End(xlUp).Row
    M = B.Cells(Rows.Count, "H").End(xlUp).Row

    For i = 1 To M
        v1 = B.Cells(i, "H").Value
        v2 = B.Cells(i, "M").Value
        For j = 1 To N
            If v1 = A.Cells(j, "H").Value Then
                A.Cells(j, "M").Value = A.Cells(j, "M").Value - v2
                Exit For
            End If
        Next j
    Next i
End Sub
查看更多
登录 后发表回答