Vba 从用户表单复制粘贴
我制作了一个用户表单。它包含大约19个组合框。组合框有两个选项Vba 从用户表单复制粘贴,vba,excel,combobox,Vba,Excel,Combobox,我制作了一个用户表单。它包含大约19个组合框。组合框有两个选项YES和NO。然后，在每个组合框前面都有一个文本框，可以在其中键入注释。我想要的是，如果用户从组合框中选择“否”，我想将该组合框的注释从userform复制粘贴到另一张excel表上。现在我正在复制粘贴所有评论。所以我也想添加这个特性。下面是我目前使用的代码。谁能帮我升级这段代码，添加上述功能以及 Private Sub () Dim ws As Worksheet Set ws = Worksheets("PQCILDMS") D
YESNOPrivate 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
ComboBox1、ComboBox2..ComboBox19TextBox1、textBox2。。。TextBox19TextBox1ComboBox1Private 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
ComboBox1、ComboBox2..ComboBox19TextBox1、textBox2。。。TextBox19TextBox1ComboBox1Private 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
作为适当重命名彼此面对的文本框和组合框（建议的方法）的替代方法，您可以通过检查文本框水平轴（例如：Userfom布局中的中坐标）是否与组合框相交来获得面对给定组合框的文本框 因此，您可以将以下代码放入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
选项显式
将Cbs设置为集合“作为适当重命名彼此面对的文本框和组合框（建议的方法）的替代方法，您可以通过检查文本框水平轴（例如：Userfom布局中的中坐标）是否与组合框相交来获得面向给定组合框的文本框
因此，您可以将以下代码放入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
选项显式
Dim Cbs As Collection“组合框有两个选项YES
和NO
”，那么为什么不使用复选框呢？您的组合框
（或更合适的复选框
）可以链接到特定的单元格-因此在代码中，您可以读取那些复选框的值，以便筛选哪些值要复制，哪些值不是“组合框有两个选项YES
和NO
”，那么为什么不使用复选框呢？您的组合框
（或者更适合复选框
）可以链接到特定单元格-所以在代码中，您可以读取这些复选框的值，以便筛选要复制的值和要复制的值not@ShajeeRehman当前位置如果你能把feedbakcs给那些试图帮助的人，那就太好了you@ShajeeRehman当前位置如果你能给那些试图帮助你的人提供feedbakcs，那就太好了