在以下位置拆分信息:并将第二部分推送到Excel中的另一个工作表

时间:2014-03-21 17:40:30

标签: excel vba excel-vba

我似乎无法拆分这些单元格中的信息并将其放到另一张纸上。我也许正在以最艰难的方式做这件事。我目前使用此代码循环遍历所有行,查找具有一个值的信息并将其发送到一个工作表并使用另一个值并将其发送到另一个工作表。现在的问题是我只想发送部分值。这是我目前的代码和我做的尝试。

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

1 个答案:

答案 0 :(得分:3)

未测试:

编辑:将Split(),Trim()移动到一个单独的函数:

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"