VBA用户窗体选中Quote #仍提示未选择，如何实现同行数据跨表传输？

问题原因 #

你的代码中通过FormQuotes.ListQuotes.Tag获取选中的Quote #，但ComboBox的Tag属性不会自动同步选中项的值——默认情况下Tag是空字符串，所以即使你在下拉框中选了选项，quoteNumber依然为空，触发了提示弹窗。

修复方案 #

方案1：直接获取ComboBox的选中值（推荐） #

不需要依赖Tag属性，直接读取ComboBox的Value或Text属性来获取选中项：

' 替换原代码中的quoteNumber赋值行
quoteNumber = FormQuotes.ListQuotes.Value

或者用Text属性（效果一致）：

quoteNumber = FormQuotes.ListQuotes.Text

方案2：通过ComboBox事件同步Tag值（如果必须用Tag） #

如果你坚持要用Tag属性存储选中值，需要在用户窗体的代码中添加Change事件，每次选中选项时更新Tag：
打开FormQuotes的代码窗口，添加以下代码：

Private Sub ListQuotes_Change()
    ' 选中选项时，将Tag同步为选中值
    Me.ListQuotes.Tag = Me.ListQuotes.Value
End Sub

额外优化建议 #

1. 明确窗体显示模式：在调用窗体时指定vbModal，确保窗体关闭后再执行后续逻辑（原代码默认是模态，但显式写出更清晰）：

   FormQuotes.Show vbModal
   

2. 确保ComboBox选项正确加载：如果你的ComboBox还没设置初始化加载逻辑，在FormQuotes的Initialize事件中添加代码，从表格列加载选项：

   Private Sub UserForm_Initialize()
       Dim wsTaskCodes As Worksheet
       Set wsTaskCodes = ThisWorkbook.Sheets("Task Codes")
       ' 从A2开始加载数据（假设A1是表头）
       Me.ListQuotes.List = wsTaskCodes.Range("A2:A" & wsTaskCodes.Cells(wsTaskCodes.Rows.Count, "A").End(xlUp).Row).Value
   End Sub
   

修改后的完整代码 #

Sub TransferDataBasedOnQuote()
    Dim wsTaskCodes As Worksheet
    Dim wsInvoiceForm As Worksheet
    Dim quoteNumber As String
    Dim quoteRow As Range
    Dim projectNameCell As Range
    Dim pridCell As Range
    Dim billCodeCell As Range
    
    ' Set references to the worksheets
    Set wsTaskCodes = ThisWorkbook.Sheets("Task Codes")
    Set wsInvoiceForm = ThisWorkbook.Sheets("Invoice Log and Form")
    
    ' 显示模态窗体，确保关闭后再执行后续代码
    FormQuotes.Show vbModal
    
    ' 直接获取ComboBox选中值（替换原Tag的方式）
    quoteNumber = FormQuotes.ListQuotes.Value
    
    ' Ensure that a valid quote number was selected
    If quoteNumber = "" Then
        MsgBox "Please select a Quote # from the ListQuotes ComboBox.", vbExclamation
        Exit Sub
    End If
    
    ' Find the Quote # in column A of Task Codes sheet
    Set quoteRow = wsTaskCodes.Columns("A").Find(quoteNumber, LookIn:=xlValues, LookAt:=xlWhole)
    
    ' If Quote # is not found, show a message and exit
    If quoteRow Is Nothing Then
        MsgBox "Quote # not found. Please try again.", vbExclamation
        Exit Sub
    End If
    
    ' Find "Project Name:" and transfer data
    Set projectNameCell = wsInvoiceForm.Cells.Find(What:="Project Name:", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not projectNameCell Is Nothing Then
        projectNameCell.Offset(0, 1).Value = quoteRow.Offset(0, 1).Value ' Assuming "Project Name" is in the second column (B)
    Else
        MsgBox "'Project Name:' not found in Invoice Form", vbExclamation
        Exit Sub
    End If
    
    ' Find "Project ID:" and transfer data
    Set pridCell = wsInvoiceForm.Cells.Find(What:="Project ID:", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not pridCell Is Nothing Then
        pridCell.Offset(0, 1).Value = quoteRow.Offset(0, 8).Value ' Assuming "Project ID" is in the 9th column (I)
    Else
        MsgBox "'Project ID:' not found in Invoice Form", vbExclamation
        Exit Sub
    End If
    
    ' Find "Billing Code" and transfer data
    Set billCodeCell = wsInvoiceForm.Cells.Find(What:="Bill to Task Code:", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not billCodeCell Is Nothing Then
        billCodeCell.Offset(0, 1).Value = quoteRow.Offset(0, 9).Value ' Assuming "Billing Code" is in the 10th column (J)
    Else
        MsgBox "'Billing Code:' not found in Invoice Form", vbExclamation
        Exit Sub
    End If
    
    ' Add more transfers as needed based on your structure
    
    ' Notify the user of the successful transfer
    MsgBox "Data successfully transferred for Quote # " & quoteNumber, vbInformation
End Sub

内容的提问来源于stack exchange，提问作者Taylor Wiseman