将信息拆分为：并将第二部分推送到Excel中的另一个工作表

我似乎无法拆分这些单元格中的信息，并把它放到另一个表单上。 另外我可能以最难的方式做到这一点。 我目前使用这个代码循环所有的行，find一个值的信息，并将其发送到一个表和另一个值，并将其发送到另一个表。 现在的问题是我只想发送一部分的价值。 这是我目前的代码和我做的一个尝试。

j = 2 i = 2 k = 4 Do While ws.Cells(k, 1) <> "" If ws.Cells(k, 2) = "Data Not Found" Then Invalid.Cells(i, 1) = ws.Cells(k, 1) i = i + 1 Else SEI.Cells(j, 1) = ws.Cells(k, 1) SEI.Cells(j, 2) = ws.Cells(k, 2) SEI.Cells(j, 3) = ws.Cells(k, 3) SEI.Cells(j, 4) = ws.Cells(k, 4) SEI.Cells(j, 5) = ws.Cells(k, 5) SEI.Cells(j, 6) = ws.Cells(k, 6) SEI.Cells(j, 7) = ws.Cells(k, 7) SEI.Cells(j, 8) = ws.Cells(k, 8) j = j + 1 End If k = k + 1 Loop 

我编辑的代码尝试和拆分….这是工作！，它不循环，做B4，B5，B6 ….我以前这样做，它的作品，所以任何意见将是伟大的我的猜测我正在使用的公式

 With SEI.Cells(j, 1) .Formula = ws.Cells(k, 1) End With With SEI.Cells(j, 2) .Formula = "=MID(INPUT!B4,SEARCH("":"",INPUT!B4)+1,LEN(INPUT!B4)-SEARCH("":"",INPUT!B4)+1)" End With With SEI.Cells(j, 3) .Formula = "=MID(INPUT!C4,SEARCH("":"",INPUT!C4)+1,8)" End With With SEI.Cells(j, 4) .Formula = ws.Cells(k, 4) End With With SEI.Cells(j, 5) .Formula = "=LEFT(INPUT!E4,SEARCH("":"",INPUT!E4)-1)" End With With SEI.Cells(j, 6) .Formula = "=LEFT(INPUT!F4,SEARCH("":"",INPUT!F4)-1)" End With With SEI.Cells(j, 7) .Formula = "=LEFT(INPUT!G4,SEARCH("":"",INPUT!G4)-1)" End With With SEI.Cells(j, 8) .Formula = "=LEFT(INPUT!H4,SEARCH("":"",INPUT!H4)-1)" End With 

Answer 1

未经testing：

编辑：将拆分（），修剪（）到一个单独的function：

 Sub Tester() '.... '.... j = 2 i = 2 k = 4 Do While ws.Cells(k, 1) <> "" If ws.Cells(k, 2) = "Data Not Found" Then Invalid.Cells(i, 1) = ws.Cells(k, 1) i = i + 1 Else With SEI.Rows(j) .Cells(1).Value = ws.Cells(k, 1).Value .cells(2).Value = GetValue(ws.cells(k, 2), 2) .cells(3).Value = GetValue(ws.cells(k, 3), 2, 8) .Cells(4).Value = ws.Cells(k, 4).Value .cells(5).Value = GetValue(ws.cells(k, 5), 1) .cells(6).Value = GetValue(ws.cells(k, 6), 1) .cells(7).Value = GetValue(ws.cells(k, 7), 1) .cells(8).Value = GetValue(ws.cells(k, 8), 1) End With j = j + 1 End If k = k + 1 Loop End Sub Function GetValue(valIn, partNum As Long, Optional length As Long = 0) Dim rv rv = "" On Error Resume Next rv = Trim(Split(valIn, ":")(partNum - 1)) On Error GoTo 0 If Len(rv) = 0 Then rv = "???" 'comment out this line if you just want ' nothing returned if no content matched On Error GoTo 0 If length > 0 Then rv = Left(rv, length) GetValue = Trim(rv) End Function 

使用Split() ：

 Split("A:B:C", ":")(0) is "A" Split("A:B:C", ":")(1) is "B" Split("A:B:C", ":")(2) is "C"