如果单元格值与UserForm ComboBox列匹配，则复制到工作表

Question

我想做的是：

1. 循环播放工作表中的第Q列＆＃34; Global＆＃34;从第3行开始

2. 对于UserForm ComboBox2 Column2的每个单元格匹配值，并将整行复制到userform2 coloum1中的相关工作表。

3. 循环直到最后一行。列Q中可能有多个唯一值，但都将出现在Userform2的Combobox2列中。

我没有代码作为例子，因为我不知道从哪里开始！

这是我的comboxbox，就像显示一样，在它的支持下，每个项目都有下面的代码，所以一个名字，一个代码＆＃34; 2780＆＃34;和参考＆＃34; BRREPAIRS＆＃34;。

.AddItem "Repairs"
ComboBox2.List(13, 1) = "2780"
ComboBox2.List(13, 2) = "BRRPEAIRS"



我需要它遍历G列中全局表单上的每个单元格，然后将单元格值与第2列中的组合框列表项匹配。一旦找到匹配项，它就会使用第1列中的代码，即＆＃34; 2780＆＃34;将整行复制到与第1列中的代码匹配的工作表。

希望我能更好地解释一下。

Answer 1

Private Sub CommandButton1_Click()

    Dim findmatch As Object
    Dim lastcell As Integer

    Set findmatch = ThisWorkbook.Sheets("Global").Range("G:G").Find(What:=UserForm2.ComboBox2.column(1), LookIn:=xlValues)
    If Not findmatch Is Nothing Then
    lastcell = ThisWorkbook.Sheets(UserForm2.ComboBox2.Value).Cells(100000, 7).End(xlUp).row 'here find a way to locate last cell in sheet that has your name.. it keeps returning me 1 but other than that it works fine
    ThisWorkbook.Sheets(UserForm2.ComboBox2.Value).Range(Cells(lastcell, 1), Cells(lastcell, 40)) = Range(Cells(findmatch.row, 1), Cells(findmatch.row, 40)).Value
    Else
    MsgBox "not found"
    End If
    End Sub

Answer 2

我设法让它使用下面的代码。它在组合框中寻找正确的单元格。然后将其复制到正确位置的正确工作表。

唯一的问题是它运行速度非常慢!!任何人都可以提出一些加快速度的方法吗？

最后一个问题是，如果纸张不存在则需要进行错误处理，它会告诉您创建纸张，还是为您创建纸张？

我非常感谢所有帮助过的人，几天来一直在墙上砸我的头！

Dim i, lastD, lastG As Long
Dim j As Integer
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .CutCopyMode = False
End With

' find last row
lastG = sheets("Global").Cells(Rows.Count, "Q").End(xlUp).row

For i = 3 To lastG
    lookupVal = sheets("Global").Cells(i, "Q") ' value to find
    ' loop over values in "details"
    For j = 0 To Me.ComboBox2.ListCount - 1
        currVal = Me.ComboBox2.List(j, 2)
        If lookupVal = currVal Then
        sheets("Global").Cells(i, "Q").EntireRow.Copy
        sheets(Me.ComboBox2.List(j, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
        End If
    Next j
Next i

 With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .CutCopyMode = True
End With