Question

我有这个代码将我的Userform数据带到我的Cell：

Private Sub CommandButton1_Click()
Sheets("hoja2").Select 'selecciona la hoja "datos"
Range("B8").Select 'selecciona el rango (en este caso la celda) "A1"
Do While Not IsEmpty(ActiveCell) 'encuentra la ultima celda con datos
ActiveCell.Offset(1, 0).Select 'en la ultima celda con datos, muevete una fila abajo
Loop 'bucle
ActiveCell = ListBox1
ActiveCell.Offset(0, 1).Select
ActiveCell = ListBox2
ActiveCell.Offset(0, 1).Select
ActiveCell = ListBox3
ActiveCell.Offset(0, 1).Select
ActiveCell = TextBox1
ActiveCell.Offset(0, 1).Select
ActiveCell = TextBox2 'copia el contenido del textbox2 a la celda activa
ActiveCell.Offset(0, 1).Select
ActiveCell = TextBox3
ActiveCell.Offset(0, 1).Select
ActiveCell = ListBox4
ActiveCell.Offset(0, 1).Select
ActiveCell = ListBox5
ActiveCell.Offset(0, 1).Select
ActiveCell = ListBox6
ActiveCell.Offset(0, 1).Select
ActiveCell = ImpGlob
ActiveCell.Offset(0, 1).Select
ActiveCell = TextBox4
ActiveCell.Offset(0, 1).Select
ActiveCell = TextBox5
ActiveCell.Offset(0, 1).Select
ActiveCell = TextBox6
ActiveCell.Offset(0, 1).Select
TextBox1 = Empty 'textbox1, dejar en blanco
TextBox2 = Empty 'etc
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox6 = Empty
ListBox1 = Empty 'textbox1, dejar en blanco
ListBox2 = Empty 'etc
ListBox3 = Empty
ListBox4 = Empty
ListBox5 = Empty
ListBox6 = Empty
MsgBox "Datos guardados" 'mostrar el mensaje "Datos guardados"
End Sub

问题在于，当我为某些需要多项选择的列表框选择多个项目时，该单元格会保持空白。

有没有办法把这些物品放在像项目1，第2项，第3和第34项的清单中;在单个细胞中？

提前致谢

Answer 1

使用vbCrLf（回车/换行），如下所示：

ActiveCell.Value = "item 1" & vbCrLf & "item 2" & vbCrLf & "item 3"

<强>更新

那时你的问题不是很清楚。试试这个：

Private Sub Test()
  Dim nIndex As Integer

  Range("A1").Value = ""
  For nIndex = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(nIndex) Then
      Range("A1").Value = ListBox1.List(nIndex, 0) & vbCrLf & Range("A1").Value
    End If
  Next
  Range("A1").Value = Left$(Range("A1").Value, Len(Range("A1").Value) - 1)
End Sub

根据您的需要进行修改。显然，您必须更改列表框的名称以匹配您的名称，并以某种方式触发例程，并更改范围以满足您的需要。

Answer 2

我想我明白你想要什么，我昨天做了一些非常相似的事情;从多个文本框/列表框中获取所有信息，并将其放在“表格”底部的新行中。这是一个使用你的名字：

Public Sub NuevoDatos()
Dim wks As Worksheet
Dim Dtab As Object
Dim Tbox As OLEObject
Dim R As Long, C As Long, i As Long
Dim Ans As Variant
Set wks = Sheets("hoja2")
Set Dtab = Sheets("hoja2").ListObjects("Table1")
Dim N As Long
N = Dtab.HeaderRowRange.Row + ActiveSheet.ListObjects(1).ListRows.Count
Ans = MsgBox("Crear una nueva entrada?", vbYesNo, "Entrada de datos")
    If Ans = vbNo Then
        ActiveSheet.TextBox1.Activate
        Exit Sub
    End If
    If Ans = vbYes Then
    Dtab.ListRows.Add AlwaysInsert:=True
    R = Dtab.ListRows.Count
    C = Dtab.ListColumns.Count
    Dtab.ListRows(R).Range.Cells(1).Value = Now()
    For i = 1 To 3
        Dtab.ListRows(R).Range.Cells(i + 1).Value = wks.OLEObjects("ListBox" & i).Object.List(ActiveSheet.OLEObjects("ListBox" & i).Object.ListIndex)
        wks.OLEObjects("ListBox" & i).Object.ListIndex = -1
    Next i
    For i = 4 To 6
        Dtab.ListRows(R).Range.Cells(i + 1).Value = wks.OLEObjects("TextBox" & (i - 3)).Object.Value
        wks.OLEObjects("TextBox" & (i - 3)).Object.Value = ""
    Next i
    For i = 7 To 9
        Dtab.ListRows(R).Range.Cells(i + 1).Value = wks.OLEObjects("ListBox" & (i - 3)).Object.List(ActiveSheet.OLEObjects("ListBox" & (i - 3)).Object.ListIndex)
        wks.OLEObjects("ListBox" & (i - 3)).Object.ListIndex = -1
    Next i
    For i = 10 To 12
        Dtab.ListRows(R).Range.Cells(i + 1).Value = wks.OLEObjects("TextBox" & (i - 6)).Object.Value
        wks.OLEObjects("TextBox" & (i - 6)).Object.Value = ""
    Next i
MsgBox "¡Entrada de datos completa! xD "
End If
End Sub

所以，我试着让它像你想要的那样工作;）享受〜！注意：此子目录适用于此上的activeX列表框/文本框...语法根据您使用的类型而变化

如何将Listbox选择连接到单个单元格中

2 个答案: