从userform复制粘贴

我做了一个用户表单。 它包含大约19个combobox。 combobox有2个选项YES和NO 。 然后在每个combobox的前面出现一个文本框，其中input了注释。 我想要的是，如果用户从combobox中select“否”，我想复制粘贴该combobox的注释从userform到另一个Excel表单。 现在我正在复制粘贴所有评论。 所以我想要添加这个function。 以下是我目前使用的代码。 任何人都可以帮助我升级这个代码，以及添加上面提到的function。

 Private Sub () Dim ws As Worksheet Set ws = Worksheets("PQCILDMS") Dim newRow2 As Long newRow2 = Application.WorksheetFunction.CountA(ws.Range("A:A")) + 1 ws.Cells(newRow2, 1).Value = cmbDMS.Value Dim newRow3 As Long newRow3 = Application.WorksheetFunction.CountA(ws.Range("A:A")) + 1 ws.Cells(newRow3, 1).Value = cmbYesNo.Value Dim newRow4 As Long newRow4 = Application.WorksheetFunction.CountA(ws.Range("A:A")) + 1 ws.Cells(newRow4, 1).Value = Me.txtComments.Value ws.Cells(newRow4, 1).Columns.AutoFit End Sub 

Answer 1

我想从userform复制粘贴该combobox的评论

我想你的意思是复制TextBox的评论？

处理此问题的最佳方法是将ComboBoxes命名为ComboBox1, ComboBox2..ComboBox19 。 同样的文本框，将它们命名为TextBox1, textBox2... TextBox19 。 确保TextBox1在ComboBox1 ，等等。

我们这样做的原因是为了更容易循环。 看到这个例子

 Private Sub CommandButton1_Click() Dim ws As Worksheet Dim lRow As Long, i As Long '~~> Change this to the relevant sheet Set ws = Sheet1 With ws lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1 For i = 1 To 19 If Me.Controls("ComboBox" & i).Value = "No" Then .Cells(lRow, 1).Value = Me.Controls("TextBox" & i).Value lRow = lRow + 1 End If Next i End With End Sub 

Answer 2

作为适当重命名texbox和combobox（combobox）的替代方法（build议的方法），可以通过检查文本框水平轴 （例如：它在UserFom布局中的中间坐标）是否穿过combobox来使文本框面对给定的combobox

所以你可以把下面的代码放到你的userfom代码窗格中：

 Option Explicit Dim Cbs As Collection '<--| set this collection as Userform scoped variable Dim Tbs As Collection '<--| set this collection as Userform scoped variable Private Sub CommandButton1_Click() Dim cb As MSForms.ComboBox, tb As MSForms.TextBox Dim el As Variant With Worksheets("PQCILDMS") '<--| reference sheet For Each el In Cbs '<--|loop through all userform comboboxes Set cb = el '<--|set the current combobox control If cb.value = "NO" Then '<--|if its value is "NO" ... Set tb = GetTbNextToCb(cb, Tbs) '<--|... look for the textbox whose horizontal axis is inbetween the current combobox If Not tb Is Nothing Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1).value = tb.value '<--|... if found it then write its content in referenced sheet column "A" next available cell End If Next el End With End Sub Function GetTbNextToCb(cb As MSForms.ComboBox, Tbs As Collection) As MSForms.TextBox Dim tb As MSForms.TextBox Dim cbYMin As Long, cbYMax As Long, tbYMin As Long, tbYMax As Long Dim el As Variant GetYMinMax cb, cbYMin, cbYMax '<--| get minimum and maximum ordinate of passed combobox For Each el In Tbs '<--|loop through all userform textboxes Set tb = el '<--|set the current textbox control If IsAxisInBetween(tb, cbYMin, cbYMax) Then '<--|if current textbox horizontal axis inbetween passed combobox minimum and maximum ordinates... Set GetTbNextToCb = tb '...return the found textbox... Exit Function '<--|... and exit function (no need to iterate over remaining textboxes) End If Next el End Function Function IsAxisInBetween(ctrl As Control, yMinRef As Long, yMaxRef As Long) As Boolean Dim yMin As Long, yMax As Long GetYMinMax ctrl, yMin, yMax '<--| get minimum and maximum ordinates of the control in the userform IsAxisInBetween = (yMax + yMin) / 2 <= yMaxRef And (yMax + yMin) / 2 >= yMinRef '<--| check if the control orizontal axis is in between the reference ordinates End Function Sub GetYMinMax(ctrl As Control, yMin As Long, yMax As Long) With ctrl yMin = .Top '<--| get the minimum ordinate of the control in the Userform yMax = .Top + .Height '<--| get the maximum ordinate of the control in the Userform End With End Sub 'this sub will run at Userfom loading Private Sub UserForm_Initialize() Set Cbs = GetCtrls("ComboBox") '<--| gather all Userform comboboxes in this collection Set Tbs = GetCtrls("TextBox") '<--| gather all Userform texboxes in this collection End Sub Function GetCtrls(ctrlTypeName As String) As Collection Dim coll As New Collection '<--| declare and set a new Collection object Dim ctrl As Control For Each ctrl In Me.Controls '<--| loop through all Userform controls If TypeName(ctrl) = ctrlTypeName Then '<--| if it matches the passed Type name... coll.Add ctrl, ctrl.Name '<--| ... then add it to the collection End If Next ctrl Set GetCtrls = coll '<--| return the collection End Function