首页 文章

比较值并粘贴另一个工作表中的相应值

提问于
浏览 次
-3

我是一个棘手的问题，所以这里有我需要的一个例子，以及到目前为止我做了什么......
enter image description here

enter image description here

现在，如果您查看第1张图片是sheet1，第2张图片是图纸2，我需要检查sheet1的userID（ColumnA），对照Sheet2的Awardexternal ID（ColumnA），然后是另一张检查 - 在Sheet2中输入的金额.ColumnM兑换在相应的UserID行中输入的金额D3 - M3.sheet1：

示例 - 用户A1111111作为移动电话账单费用已经损失100美元，我想要做的就是检查用户ID，然后比较他们输入的金额，然后粘贴正确的“TYPE”费用（在这种情况下 - 手机账单） ）在sheet2列P.

到目前为止我所做的是：

Application.ScreenUpdating = False

Dim j As Long, i As Long, lastRow1 As Long, lastRow2 As Long

Dim MyName As String

lastRow1 = ws1.UsedRange.Rows.Count

For j = 2 To lastRow1
MyName = ws1.Cells(j, 1).Value


lastRow2 = ws2.UsedRange.Rows.Count

For i = 2 To lastRow2
    If ws2.Cells(i, 3).Value = MyName Then
        ws2.Cells(i, 13).Value = ws1.Cells(j, 2).Value
    End If

Next i

Next j

Application.ScreenUpdating = True

当我尝试运行它时，它只是崩溃了工作簿 . 没有任何反应 .

PS - 我是VBA的新手，并且没有任何经验 . 无论我做了什么，谷歌搜索，然后尝试使逻辑工作 .

任何帮助表示赞赏！提前致谢！！ :)

我需要输出看起来像这样：
enter image description here

excel vba excel-vba

1 回答

  • 0

    将此代码放在 Sheet1 VBA Module 中：

    Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lr As Long

    lr = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
    With Target
       If Not Intersect(Target, Me.Range("D2:M" & lr)) Is Nothing And .CountLarge = 1 Then
          If Not IsError(.Value) Then
             If Len(.Value2) > 0 Then
                'Copy User ID, Submitted Date, and Amount (+ Amount Description)
                 CopyData Me.Cells(.Row, "A"), Me.Cells(.Row, "C"), Target
             End If
          End If
       End If
    End With
End Sub

    将此代码放在 Standard VBA Module 中：

    Option Explicit

Public Sub CopyData(ByRef usrId As Range, ByVal amtDate As Range, ByVal amt As Range)
    Const COL_USER = "A"
    Const COL_DATE = "H"
    Const COL_RATE = "M"    'Amount
    Const COL_DESC = "P"    'Amount description (Sheet1 Header)

    Dim ws1 As Worksheet:   Set ws1 = usrId.Parent
    Dim ws2 As Worksheet:   Set ws2 = Sheet2

    Dim lr2 As Long, r2 As Variant, usrRng As Range, usrRow2 As Long
    Dim ws1data As Range, ws2data As Range

    lr2 = ws2.Cells(ws2.Rows.Count, COL_USER).End(xlUp).Row
    Set usrRng = ws2.Range(ws2.Cells(1, COL_USER), ws2.Cells(lr2, COL_USER))  'Sheet2.ColA

    r2 = Application.Match(usrId.Value2, usrRng, 0) 'Find User Id on Sheet2

    If Not IsError(r2) Then
        r2 = r2 + 1
        ws2.Rows(r2).Insert Shift:=xlDown   'Insert a new row under it
    Else
        r2 = lr2    'Insert a new record in the first empty row
    End If
    ws2.Cells(r2, COL_USER) = usrId.Value2  'Copy data
    ws2.Cells(r2, COL_DATE) = amtDate.Value
    ws2.Cells(r2, COL_RATE) = amt.Value
    ws2.Cells(r2, COL_DESC) = ws1.Cells(1, amt.Column)
End Sub

    它能做什么：

    • 当用户在Sheet1中输入金额时，对于我的测试数据中的ex "Amt 7"（图像波纹管，col J）

    • 如果用户仅修改了1个单元格，则单元格在 "D2:M" & lr 范围内

    • 并且如果输入的金额不是错误（ex =1/0 ），或粘贴为错误

    • 并且用户不仅删除了金额（空单元格）

    • 在Sheet2上查找输入金额的单元格的用户ID

    • 如果在Sheet2上找到用户ID，它会将当前值从Sheet1复制到Sheet2

    • 用户ID - 从Sheet1.ColA到Sheet2.ColA

    • Date - 从Sheet1.ColC到Sheet2.ColH

    • 金额 - 从Sheet1.CurrentCol到Sheet2.ColM（costItemRate）

    • Amt Desc - 从Sheet1.ColC（Row1 - Header）到Sheet2.ColP

    • 如果找不到，请将Sheet1中的当前值复制到Sheet2的第一个空行

    测试数据

    Sheet1

    Sheet1

    Sheet2 （输出）

    Sheet2

    回复于

相关问题