excel VBA 拆分行

Private Sub CommandButton1_Click() Dim i As Integer Dim strString As String Dim arrResult_1() As String Dim arrResult_2() As String Dim arrResult_3() As String Dim arrResult_4() As String Dim arrResult_5() As String Dim j As Integer For Each c In Range("d:d") i = i + 1 Range("D" & i & ":D" & i).Select Set r = Range("D" & i & ":D" & i).Find("、") If Not r Is Nothing Then 'r.Interior.Color = vbRed r.Select 'MsgBox "已经找到" arrResult_1 = Split(Range("D" & i & ":D" & i).Value, "、") arrResult_2 = Split(Range("E" & i & ":E" & i).Value, "、") arrResult_3 = Split(Range("F" & i & ":F" & i).Value, "、") arrResult_4 = Split(Range("G" & i & ":G" & i).Value, "、") arrResult_5 = Split(Range("H" & i & ":H" & i).Value, "、") 'MsgBox "数组长度：" & ArrayLength(arrResult) For j = 0 To ArrayLength(arrResult_1) - 1 Rows(i).Select Selection.Interior.Color = vbYellow '背景色[/code] Rows(Selection.Row).Insert Rows(Selection.Row + 1).EntireRow.Copy Range("a" & Selection.Row) Range("D" & i & ":D" & i).Value = arrResult_1(j) Range("E" & i & ":E" & i).Value = "'" & arrResult_2(j) Range("F" & i & ":F" & i).Value = "'" & arrResult_3(j) Range("G" & i & ":G" & i).Value = arrResult_4(j) Range("H" & i & ":H" & i).Value = arrResult_5(j) i = i + 1 Next Rows(i).Delete shift:=xlUp '删除行 i = i - 1 Else 'MsgBox "没有找到" End If If i > Sheet1.UsedRange.Rows.Count Then Exit For End If Next End Sub Public Function ArrayLength(ByVal ary) As Integer ArrayLength = UBound(ary) - LBound(ary) + 1 End Function

同一行文字中以、号分割成多行 拆分前：

拆分后：