现在的位置: 首页 > 综合 > 正文

Excel VBA 将一条记录分为多条记录

2012年09月17日 ⁄ 综合 ⁄ 共 1123字 ⁄ 字号 评论关闭
 Sub get_record()
      On Error Resume Next
      For i = [a65536].End(xlUp).Row To 1 Step -1
            'MsgBox i
            DoEvents
            For y = 1 To 255
                 'MsgBox y
                  n = 0
                  Do While True
                      s_string = 0
                      s_string = WorksheetFunction.Find("、", Cells(i, y), 1)
                      'MsgBox s_string
                      'MsgBox Len(Cells(i, y))
                      If s_string = 0 Then GoTo g_next1
                      Rows(i + n + 1).Insert
                      n = n + 1
                      If s_string = 1 Then
                      Cells(i + n, y).Value = "--- "
                      Else
                      Call copy_record(i, n)
                      Cells(i + n, y).Value = Left(Cells(i, y), WorksheetFunction.Find("、", Cells(i, y), 1) - 1)
                      Cells(i, y).Value = Right(Cells(i, y), Len(Cells(i, y)) - WorksheetFunction.Find("、", Cells(i, y), 1))
                      End If
                      'If y > 1 Then If Len(Cells(i + n, 1).Value) < 1 Then Cells(i + n, 1).Value = Cells(i + n - 1, 1).Value
                Loop
g_next1:   Next
      Next
End Sub

Sub copy_record(i, n)
    For k = 1 To 255
     Cells(i + n, k).Value = Cells(i, k).Value
    Next
End Sub

抱歉!评论已关闭.