Question

我目前正在尝试运行一个宏来查找来自＆＃39;表1＆＃39;的A列的值。在表2的A列中，如果匹配那么它应该检查Sheet1中D3：M3的值与Sheet2中的列M中的值，如果它们匹配则它应该将相应的值从SHeet1 D2复制到M2，进入ColumnP的Sheet2 。我知道这是一个棘手的问题，所以这里有我需要的一个例子，以及到目前为止我所做的事情。

现在，如果您查看第1张图片的第1张图片，第2张图片是第2张图片，我需要检查图片1的userID（ColumnA），以及Sheet2的Awardexternal ID（ColumnA），然后是另一个支票 - 在Sheet2.ColumnM中输入的金额相对于在这种情况下在相应的用户名ID行中输入的金额D3 - M3.sheet1：

示例 - 用户A1111111作为移动电话账单费用已经损失100美元，我想要做的就是检查用户ID，然后比较他们输入的金额，然后粘贴正确的＆＃34; TYPE＆＃34;费用（在这种情况下 - 手机账单）在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的新手，并且没有任何经验。无论我做了什么，谷歌搜索，然后尝试使逻辑工作。

任何帮助表示赞赏！提前致谢！！：）

我需要输出看起来像这样：

Answer 1

将此代码放在 Sheet1 VBA模块：

中

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

将此代码放在标准VBA模块：

中

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中输入金额时，对于前＆＃34; Amt 7＆＃34;在我的测试数据中（图像波纹管，col J）
如果用户仅修改了1个单元格，则单元格位于"D2:M" & lr范围内
- 如果输入的金额不是错误（ex =1/0），或粘贴为错误
- 用户并没有删除金额（空单元格）
在Sheet2上查找输入金额的单元格的用户ID
- 如果在Sheet2上找到用户ID，则会将当前值从Sheet1复制到Sheet2
  - 用户ID - 从Sheet1.ColA到Sheet2.ColA
  - 日期 - 从Sheet1.ColC到Sheet2.ColH
  - 金额 - 从Sheet1.CurrentCol到Sheet2.ColM（costItemRate）
  - Amt Desc - 从Sheet1.ColC（Row1 - Header）到Sheet2.ColP
- 如果找不到，请将当前值从Sheet1复制到Sheet2的第一个空行

测试数据

<强> Sheet 1中

Sheet2 （输出）

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

1 个答案: