将一个excel单元格中的特定信息拆分为其他几个单元格
我需要find一种方法来分割Excel中的一些数据：例如，如果一个单元格有以下内容： LWPO0001653/1654/1742/1876/241之后的所有信息都是LWPO000...
有没有把它们分开并在LWPO000中join？ 所以他们出来LWPO0001653 LWPO0001654等等
我可以手动做，但我有成千上万这样做需要很长的时间。
感谢你的帮助！
这是一个使用Excel公式的解决scheme。
用A1中的原始string，假设前七个字符是重复的字符，那么：
B1: =LEFT($A1,FIND("/",$A1)-1) C1: =IF(LEN($A1)-LEN(SUBSTITUTE($A1,"/",""))< COLUMNS($A:A),"",LEFT($A1,7)&TRIM(MID(SUBSTITUTE(MID($A1,8,99),"/",REPT(" ",99)),(COLUMNS($A:A))*99,99)))
selectC1并根据需要填写。 然后从第1行填写
编辑：对于VBA解决scheme，请尝试此代码。 它假定源数据在列A中，并将结果从列B中开始放置（如有必要，可以轻松更改）。 它使用VBA中的数组，因为执行多个工作表读/写操作可能会降低速度。 它将处理不同的单元格中不同数量的分割，但是如果我们知道分割的数量总是相同，则可以缩短。
Option Explicit Sub SplitSlash() Dim vSrc As Variant Dim rRes As Range, vRes() As Variant Dim sFirst7 As String Dim V As Variant Dim COL As Collection Dim I As Long, J As Long Dim lMaxColCount As Long Set rRes = Range("B1") 'Set to A1 to overwrite vSrc = Range("a1", Cells(Rows.Count, "A").End(xlUp)) 'If only a single cell, vSrc won't be an array, so change it If Not IsArray(vSrc) Then ReDim vSrc(1 To 1, 1 To 1) vSrc(1, 1) = Range("a1") End If 'use collection since number of columns can vary Set COL = New Collection For I = 1 To UBound(vSrc) sFirst7 = Left(vSrc(I, 1), 7) V = Split(vSrc(I, 1), "/") For J = 1 To UBound(V) V(J) = sFirst7 & V(J) Next J lMaxColCount = IIf(lMaxColCount < UBound(V), UBound(V), lMaxColCount) COL.Add V Next I 'Results array ReDim vRes(1 To COL.Count, 1 To lMaxColCount + 1) For I = 1 To UBound(vRes, 1) For J = 0 To UBound(COL(I)) vRes(I, J + 1) = COL(I)(J) Next J Next I 'Write results to sheet Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2)) With rRes .EntireColumn.Clear .Value = vRes .EntireColumn.AutoFit End With End Sub
我明显错过了这一点:-)但无论如何，在B1和复制下来，以适应：
=SUBSTITUTE(A1,"/","/"&LEFT(A1,7))
selectColumnB，复制和粘贴特殊值，在顶部。
应用文本到列ColumnB，分隔，用/作为分隔符。
有几种方法可以解决这个问题。 最快的可能是：
假设数据在列A中：
- 突出显示列，转到数据>>文本到列
- select“Delimited”并在“其他”框中input
/ - 点击确定。 你将你的数据分成多个单元格
- 在B处插入一列，并将公式
=Left(A1, 7) - 在C处插入一列，并在公式=
Right(A1, Length(A1)-7) - 你现在将有你的前7个字符的列B，以及列B，C，D，E，F等等，最后一点。 您可以将每个列的值连接在一起，连接为
=Concatenate(B1,C1)，=Concatenate(B1,D1)等。
一个快速的VBa，几乎和@ Kevin一样。 在我看到他的回答之前，我写了它，我讨厌丢掉工作;）
Sub breakUpCell() Dim rngInput As Range, rngInputCell As Range Dim intColumn As Integer Dim arrInput() As String Dim strStart As String Dim strEnd As Variant 'Set the range for the list of values (Assuming Sheet1 and A1 is the start) Set rngInput = Sheet1.Range("A1").Resize(Sheet1.Range("A1").End(xlDown).Row) 'Loop through each cell in the range For Each rngInputCell In rngInput 'Split up the values after the first 7 characters using "/" as the delimiter arrInput = Split(Right(rngInputCell.Value, Len(rngInputCell.Value) - 7), "/") 'grab the first 7 characters strStart = Left(rngInputCell.Value, 7) 'We'll be writing out the values starting in column 2 (B) intColumn = 2 'Loop through each split up value and assign to strEnd For Each strEnd In arrInput 'Write the concatenated value out starting at column B in the same row as rngInputCell Sheet1.Cells(rngInputCell.Row, intColumn).Value = strStart & strEnd 'Head to the next column (C, then D, then E, etc) intColumn = intColumn + 1 Next strEnd Next rngInputCell End Sub
下面是你如何用macros来做到这一点：
这是发生了什么事情：
1）将范围设置为过程2）遍历范围内的每个单元格，并检查它是否不为空3）如果单元格中包含斜线字符，则将其拆分并处理4）跳过第一条logging并连接“LWPO000”加上当前string到相邻的单元格。
Sub CreateLWPO() On Error Resume Next Application.ScreenUpdating = False Dim theRange Dim cellValue Dim offset As Integer Dim fields 'set the range of cells to be processed here Set theRange = range("A1:A50") 'loop through each cell and if not blank process For Each c In theRange offset = 0 'this will be used to offset each item found 1 cell to the right (change this number to this first column to be populated) If c.Value <> "" Then cellValue = c.Value If InStr(cellValue, "/") > 0 Then fields = Split(cellValue, "/") For i = 1 To UBound(fields) offset = offset + 1 cellValue = "LWPO000" & fields(i) 'if you need to pad the number of zeros based on length do this and comment the line above 'cellValue = "LWPO" & Right$(String(7, "0") & fields(i), 7) c.offset(0, offset).Value = cellValue Next i End If End If Next Application.ScreenUpdating = True End Sub