如何使用VBA复制和粘贴单元格内容

请参见下面的内容：要解决的问题

注：为了更好地解释以下内容，我在底部有一份Excel电子表格副本：

我有以下VBA程序，用于查找手动输入的号码：

Sub do_it()

n = [A1]

For Each cell In Range("A15:A30,C15:C30,E15:E30,G15:G30,I15:I30")
If cell.Value = n And Range(cell.Address).Offset(0, 1) = "1-5" Then
MsgBox "Found a postivive result in " & cell.Address
End If
Next

End Sub

下面简要说明上述程序excel图形：

1我输入一个数字，A1单元格中的任意数字。假设我选择数字4

2我有5个列位置和范围，其中数字4可能位于：A15:A30、C15:C30、E15:E30、G15:G30、I15:I30。每列中都有一个数字4，但在其右侧的单元格中只有一个值

例如，当它在单元格E21中找到一个4，并且一个值（如1-5）可以是任何一组数字（如7-5或10-19），这是一个正结果。如果它们在F21中没有值，则为负值，并将继续搜索其他4，直到找到一个阳性结果。到目前为止还没有结束

解决以下excel电子表格副本的问题：

这个程序的下一部分是将上面示例中单元格F21的内容复制并粘贴到以下行之一：K1、K2、K3、K4、K5、K6、K7、K8、K9、K10、K11和K12

在本例中，单元格F21中的内容将被复制并粘贴到单元格L1。我需要程序做的是在这种情况下检查1-5中的第一个数字1，并在这种情况下选择适当的行1。程序必须始终选择单元格中两个数字中的第一个数字。如果F21中的单元格内容为5-10，则程序将5-10复制到第5行并粘贴到单元格L5中，依此类推

下一个问题是让程序在每次粘贴时复制并粘贴到唯一的单元格位置。因此，以粘贴到单元L1中的单元F21的1-5为例。下次我在A1框中输入一个新的数字时，假设数字5，程序发现一个阳性结果G24，H24的单元格内容是1-7，它复制并粘贴1-7到单元格M1，而不是单元格L1的内容。粘贴功能将始终保持在上一次复制的右侧，如果第1行从L1开始，则粘贴功能将首先使用L1，然后在整个工作表中使用M1、N1、O1、P1、Q1等

我在复制和粘贴电子表格时遇到问题，所以我会将列号放在顶部

A1                                   J  K    L   M   
4                                   ROW 1   1-5 1-7
                                    ROW 2       
                                    ROW 3       
                                    ROW 4       
                                    ROW 5       
                                    ROW 6       
                                    ROW 7       
                                    ROW 8       
                                    ROW 9       
                                    ROW 10      
                                    ROW 11      
                                    ROW 12      


5       3       4       2       12              
4       9       6       1       13              
9       7       5       10      14              
6       6       5       11      15              
7       7       7       7       16              
5       5       5       5       17              
4       4       4   1-5 4       18              
1       1       1       1       19              
6       6       6       6       20              
1       5       5       5   1-7 4               
10      5       5       5       5               
7       7       7       7       7               
6       6       6       6       6               
5       5       5       5       5               
5       11      22      33      14              
8       18      17      12      15          

结局

提前感谢您提供的任何帮助

Russ应该这样做：

Sub do_it()

    Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range

    Set sht = ActiveSheet

    n = sht.Range("A1")

    For Each cell In sht.Range("A15:A30,C15:C30,E15:E30,G15:G30,I15:I30").Cells

        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then

            'get the first number
            num = CLng(Trim(Split(tmp, "-")(0)))
            Debug.Print "Found a positive result in " & cell.Address

            'find the next empty cell in the appropriate row
            Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
            'make sure not to add before col L
            If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)

            cell.Offset(0, 1).Copy rngDest
            Exit For

        End If
    Next

End Sub

您可以利用工作表更改事件和字典对象

将此代码放在工作表代码窗格中

Option Explicit

Dim dict As Object

Sub FillDict()
    Set dict = CreateObject("Scripting.Dictionary") 'set a dictionary object

    Dim cell As Range
    For Each cell In Range("A15:A30,C15:C30,E15:E30,G15:G30,I15:I30").Offset(, 1).SpecialCells(xlCellTypeConstants) ' loop through relevant range 1-column right offset not empty cells
        dict(cell.Offset(, -1).Value) = cell.Value ' add dictionary itme with current cell one column left offset value as key and current cell value as item
    Next
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A$1" Then Exit Sub 'do nothing if changed cell is not "A1"

    If dict Is Nothing Then FillDict ' fill dictionary if not already set

    If dict.Exists(Target.Value) Then 'if current cell A1 value is in dictionary keys
        Dim rowIndex As Long
        rowIndex = CLng(Trim(Split(dict(Target.Value), "-")(0))) 'get row index from item associated to found key
        Application.EnableEvents = False 'disable events handling to prevent subsequent sheet cells writing to call this sub again
        cells(rowIndex, WorksheetFunction.Max(cells(rowIndex, Columns.Count).End(xlToLeft).Offset(0, 1).Column, 12)).Value = dict(Target.Value)
        Application.EnableEvents = True 'set events handling back
    End If
End Sub

---

这样，您的代码只需读取所有区域单元格一次，并将相关结果存储在字典中，以便在每次更改A1单元格内容时进行查询

可能会帮助您在生成表格后在代码标记Ctrl+K之间插入表格-网站上有粘贴选项可从Excel粘贴感谢您的帮助。我正在使用Tim的程序，它运行得非常好。如果我可以再提出3个请求，因为这是一个查找、复制和粘贴的问题。Hi Tim@Tim Williams Hi Tim我想知道我是否可以在您帮助我的项目上寻求您的帮助。我在这里最后有计划的细节，但无法让它工作。如果你有后续的，最好发布一个新的问题。同时，回顾你之前的问题，并接受对你有帮助的答案。我们都喜欢得到一些反馈，至少对那些花时间发布答案的人做出一些回应是礼貌的。