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

 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

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值