具有拆分和复制的Excel VBA数据组织

时间:2017-05-16 23:09:23

标签: excel vba

在Microsoft Excel中,我希望使用VBA代码对大量未经优化组织的数据进行排序

目前,我的数据如下所示: Poor Data Organization enter image description here

但是,我想将数据处理到这个: Correct Data Organization enter image description here

我无法找到适合我具体情况的例子,感谢您的时间和回应。

1 个答案:

答案 0 :(得分:0)

这会将数据处理为您所追求的格式。源数据在Sheet1中,重新格式化的数据放在Sheet2中:

Option Explicit

Sub MapCell2Cells()
  Dim sht1 As Worksheet, sht2 As Worksheet
  Set sht1 = Worksheets("Sheet1")
  Set sht2 = Worksheets("Sheet2")

  Dim strG As String, strL As String
  Dim arrH() As String, arrI() As String, arrJ() As String

  Dim i As Integer, j As Integer, idx As Integer, lastRow As Integer
  lastRow = sht1.Cells(Rows.Count, "G").End(xlUp).Row

  idx = 1
  For i = 1 To lastRow:

    With sht1
      strG = Replace(.Cells(i, "G").Value, vbLf, "")
      arrH = Split(.Cells(i, "H").Value, vbLf)
      arrI = Split(.Cells(i, "I").Value, vbLf)
      arrJ = Split(.Cells(i, "J").Value, vbLf)
      strL = Replace(.Cells(i, "L").Value, vbLf, "")
    End With

    With sht2
      For j = LBound(arrH) To UBound(arrH)
        .Cells(idx, "G").Value = strG
        .Cells(idx, "H").Value = arrH(j)
        .Cells(idx, "I").Value = arrI(j)
        .Cells(idx, "J").Value = arrJ(j)
        .Cells(idx, "L").Value = strL
        idx = idx + 1
      Next
    End With

  Next

End Sub