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
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