用户将电子表格中的值粘贴到多行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
答案 0 :(得分:1)
无需使用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
P.S。如果你想覆盖相同单元格J1 K1 L1
上的线条(我没有看到原因,但很好),那么只需将"J" & i + 1
替换为"J1"
。
答案 1 :(得分:0)
您可以使用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