Question

我的宏需要对行进行一些计算，并在用户输入ID的地方导入数据。主要是它运行在指定的ID上，因为有些数据需要更新/仔细检查，因此运行运行整个源文件并不理想。

我的代码基本上要求用户输入ID作为“条件”，然后将其与我创建的包含源中所有数据的字典进行比较，问题是使用dict.Item并没有真正进行比较尽管ID可以正确地在目标表中的每一行上运行。

'dictionary filler
For indexsrsrow = 2 To indexsrslastrow
    dict.Add CStr(srcWorksheet.Range("A" & indexsrsrow).Value), indexsrsrow 
Next indexsrsrow

dim criteria as string
criteria = inputbox("enter id")
For indexdstrow = 2 To indexlastdstrow
    'IF ID EXIST AND ITEM = CRITERIA AND C COLUMN IS EMPTY
    If dict.Exist(criteria) And destinerow.Cells(indexdstrow, "C") = "" Then

    'STUFF HAPPENS HERE

    End If
Next indexdstrow
Set dict = Nothing

还有其他方法可以将字典项与指定的用户输入进行比较吗？预先感谢。

Answer 1

@SiddharthRout Kinda，例如我是用户，我需要更新ID为123的记录（行），因此我运行宏，它要求我提供需要更新的ID，我输入123，然后按Enter，在代码中应该得到id在源工作簿上，获取数据并将其粘贴到id为123的目标工作簿中。希望可以澄清这一点。 –

我已注释了该代码，因此您在理解它时应该没有问题。让我知道这是您想要的吗？如果没有，那么发布您的查询，当我醒来时我会查看它。

Option Explicit

Sub Sample()
    Dim srcWorksheet As Worksheet, destinerow As Worksheet
    Dim dict As New Dictionary
    Dim lRow As Long, i As Long

    '~~> Set your source and destination worksheets
    Set srcWorksheet = Sheet1
    Set destinerow = Sheet2

    '~~> Add items to dict from Source worksheet
    With srcWorksheet
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To lRow
            dict.Add CStr(.Range("A" & i).Value), i
        Next i
    End With

    '~~> Ask user for the criteria
    Dim criteria As String
    criteria = InputBox("enter id")

    '~~> If user presses cancel or item doesn't
    '~~> exists in dictionary then exit sub
    If criteria = "" Then Exit Sub
    If Not dict.Exists(criteria) Then Exit Sub

    Dim rngToCopy As Range, aCell As Range

    '~~> Find the id in source so we can identify the
    '~~> range to copy
    With srcWorksheet
        Set aCell = .Range("A1:A" & lRow).Find(What:=criteria, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            '~~> I am ssuming the data that you want to copy
            '~~> is in Col B. If not then change as applicable
            Set rngToCopy = .Range("B" & aCell.Row)
        End If
    End With

    Set aCell = Nothing

    '~~> Find the id in destinations so we can identify the
    '~~> range where we need to copy
    With destinerow
        Set aCell = .Columns(1).Find(What:=criteria, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            '~~> I am ssuming the data WHERE you want to copy
            '~~> is in Col C. If not then change as applicable
            rngToCopy.Copy .Range("C" & aCell.Row)
        End If
    End With
End Sub

将用户输入值与VBA中的字典进行比较

1 个答案: