VBA编程问题

XiaoyuanQ

您好，我遇到一个问题，我想用VBA编程做一个自动更新和自动同步的功能，但是，我发现我总不能输出相应的行；然后显示图片显示的问题；您能帮我找一下原因吗？



以下是代码区域（源表区域标签、源表标签、源表和源表区域文本框 和两个按钮皆为原来设计，目标表复选框和目标表区域文本框为自动获取按钮添加）
以下是代码区域：



Private nextLeft As Double
Private nextTop As Double

Private Sub UserForm_Initialize()
    ' 初始化位置
    nextLeft = 10
    nextTop = 100 ' 调整初始位置以腾出顶部空间用于输入源表信息
End Sub

Private Sub btnAddControls_Click()
    AddControls
End Sub

Private Sub AddControls()
    ' 计算现有控件数量，减去初始的6个控件：两个标签、两个文本框、两个按钮
    Dim ctrlIndex As Integer
    ctrlIndex = (Me.Controls.Count - 6) / 2 + 1
   
    ' 添加复合框
    Dim comboBox As MSForms.comboBox
    Set comboBox = Me.Controls.Add("Forms.ComboBox.1", "comboBox" & ctrlIndex, True)
    With comboBox
        .Left = nextLeft
        .Top = nextTop
        .Width = 100
        .Height = 20
    End With
   
    ' 填充复合框内容
    Dim tableNames As Collection
    Set tableNames = GetTableNames()
    Dim i As Integer
    For i = 1 To tableNames.Count
        comboBox.AddItem tableNames(i)
    Next i
   
    ' 添加文本框
    Dim textBox As MSForms.textBox
    Set textBox = Me.Controls.Add("Forms.TextBox.1", "textBox" & ctrlIndex, True)
    With textBox
        .Left = nextLeft + 110
        .Top = nextTop
        .Width = 100
        .Height = 20
    End With
   
    ' 更新下一个控件的位置
    If nextLeft + 220 > Me.InsideWidth Then
        ' 如果超出宽度，则换行
        nextLeft = 10
        nextTop = nextTop + 30
    Else
        ' 否则向右移动
        nextLeft = nextLeft + 220
    End If
End Sub

Private Function GetTableNames() As Collection
    Dim ws As Worksheet
    Set GetTableNames = New Collection
    For Each ws In ThisWorkbook.Worksheets
        GetTableNames.Add ws.Name
    Next ws
End Function

Private Sub btnFetchData_Click()
    AutoFillData
End Sub

Private Sub AutoFillData()
    Dim sourceSheet As Worksheet
    Dim sourceRange As Range
    Dim targetSheet As Worksheet
    Dim targetColumn As Range
    Dim nextEmptyCell As Range
    Dim ctrl As Control
    Dim comboBox As MSForms.comboBox
    Dim textBox As MSForms.textBox
    Dim sourceCell As Range
   
    ' 获取源表和源区域
    On Error Resume Next
    Set sourceSheet = ThisWorkbook.Sheets(Me.txtSourceSheet.Text)
    Set sourceRange = sourceSheet.Range(Me.txtSourceRange.Text)
    On Error GoTo 0
   
    If sourceSheet Is Nothing Or sourceRange Is Nothing Then
        MsgBox "请检查源表名称和源区域输入是否正确。", vbExclamation
        Exit Sub
    End If
   
    ' 遍历所有控件
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "ComboBox" And Left(ctrl.Name, 8) = "comboBox" Then
            Set comboBox = ctrl
            ' 解析出对应的文本框名称
            Dim textBoxName As String
            textBoxName = "textBox" & Mid(comboBox.Name, 9)
            
            ' 找到对应的文本框
            On Error Resume Next
            Set textBox = Me.Controls(textBoxName)
            On Error GoTo 0
            
            If textBox Is Nothing Then
                MsgBox "找不到对应的文本框：" & textBoxName, vbExclamation
            Else
                ' 检查目标表和目标列是否有效
                If comboBox.Value <> "" And textBox.Text <> "" Then
                    On Error Resume Next
                    Set targetSheet = ThisWorkbook.Sheets(comboBox.Value)
                    Set targetColumn = targetSheet.Range(textBox.Text)
                    On Error GoTo 0
                    
                    If targetSheet Is Nothing Or targetColumn Is Nothing Then
                        MsgBox "请检查目标表名称和目标列输入是否正确。", vbExclamation
                    Else
                        ' 复制数据到目标列
                        For Each sourceCell In sourceRange
                            If Not IsEmpty(sourceCell.Value) Then
                                Set nextEmptyCell = targetColumn.Cells(targetColumn.Cells.Count).End(xlUp).Offset(1, 0)
                                nextEmptyCell.Value = sourceCell.Value
                            End If
                        Next sourceCell
                    End If
                End If
            End If
        End If
    Next ctrl
End Sub

Sub ShowAddControlsForm()
    UserForm1.Show
End Sub

大灰狼1976

我觉得问题出在这句
Set targetColumn = targetSheet.Range(textBox.Text)
textbox.text值应该是"B"吧，range("B")不对，应该是range("B:B")，要做下处理。

XiaoyuanQ

大灰狼1976 发表于 2024-8-20 10:34
我觉得问题出在这句
Set targetColumn = targetSheet.Range(textBox.Text)
textbox.text值应该是"B"吧，r ...

好的，谢谢，问题解决了