VBA TextBox将每行的值传递给单元格范围

Posted 2021-04-20

用户将电子表格中的值粘贴到多行TextBox中。 TextBox将如下所示（默认情况下以制表符分隔）：

所以每行有3个值，SKU，Qty，Price由两个标签分隔。 （有时可以省略数量或价格的值）。

现在尝试将每行的每个值传递到3个专用单元J1 K1和L1。

最终结果应如下图所示。 （单元格将被下一行的值覆盖）

到目前为止，我已成功将每行的值传递给MsgBox。

Sub passValuesToCell()    

    UserForm1.TextBox25.SetFocus
    lines = UserForm1.TextBox25.LineCount
    For i = 0 To lines - 1
        MsgBox Split(UserForm1.TextBox25, Chr(13))(i)
    Next

End Sub

如何重新编写代码以将值传递到J1 K1 L1？尝试过这辆公共汽车，但是错了

 Sub passMultiSkuToCell()
 Dim a() As String

    UserForm1.TextBox25.SetFocus
    lines = UserForm1.TextBox25.LineCount
    For i = 0 To lines - 1
        a() = Split(UserForm1.TextBox25, Chr(13))(i)
        Range("J1").Resize(UBound(a) + 1, 1).Value = a()
    Next

 End Sub

答案

无需使用SetFocus和LineCount;您可以先通过vbLf分割得到的行数，然后用vbTab分割每一行。试试这个：

Sub passValuesToCell()
    Dim lines: lines = Split(UserForm1.TextBox25.value, vbLf)
    Dim i As Long
    For i = 0 To UBound(lines)
        Sheet1.Range("J" & i + 1).Resize(, 3).value = Split(lines(i), vbTab)
    Next
End Sub

附：如果你想覆盖相同单元格J1 K1 L1上的线条（我没有看到原因，但很好）然后简单地用"J" & i + 1替换"J1"。

另一答案

您可以使用Delimiter和StartAddress来满足您的需求。如果要对其进行硬编码，可以将NumCols更改为3。

下面的代码将使用String Array和Offset命令将每一行粘贴到目标。

Sub passValuesToCell()
  ' Set active worksheet
  Dim sht As Worksheet
  Set sht = ActiveSheet

  ' Set delimiter
  Dim myDelimiter As String
  myDelimiter = Chr(13)

  ' Initial array with lines
  Dim lines(1 To 3) As String
  lines(1) = "ABC" & myDelimiter & "10" & myDelimiter & "20"
  lines(2) = "DEF" & myDelimiter & "20" & myDelimiter & "30"
  lines(3) = "GHI" & myDelimiter & "30" & myDelimiter & "40"

  ' Temporary array to get each line
  Dim NumRows As Long: NumRows = UBound(lines, 1) - LBound(lines, 1) + 1 ' Row Count - your LineCount
  Dim NumCols As Long: NumCols = UBound(Split(lines(1), myDelimiter)) + 1 ' Column count - you can hardcode it to 3

  ' Set the destination to start from
  Dim StartAddress As String: StartAddress = "A1"

  ' Set destination range to be 1 row and with NumCols columns
  Dim MyDestination As Range: Set MyDestination = sht.Range(StartAddress).Resize(1, NumCols)

  For i = 1 To NumRows
    MyDestination.Value = Split(lines(i), myDelimiter) ' Split lines to the current destination
    Set MyDestination = MyDestination.Offset(1, 0) ' go to next row in destination range
  Next i
End Sub