根据vba,excel中两行中的值拆分表中的两行

时间:2016-10-31 16:55:57

标签: excel vba

我是VBA的新手。如何根据col D和col F中的值拆分整行?我有大约1,200行。

注意:我希望在同一张表中替换旧值。

My Old Sheet看起来像这样:

multipart/form-data

预期的表格应如下所示

  A              B       C      D           E     F             G       H  
9/9/2015 9:54    500    glass   2           1   590             ABC 123 NULL
6/8/2015 8:55    501    glass   3 to 4      1   400 to 500      XYZ 259 NULL
5/8/2015 8:55    502    glass   1 to 2      1   675 to 750      J8H 1X4 NULL
1/11/2015 9:55   503    glass   Base to 2   1   425 to 575      J1K 2N1 NULL
1/1/2015 8:55    504    glass   3           2   1030 to 1050    H7G 3B5 NULL
16/1/2015 9:55   505    glass   2           2   1600 to 1800    H7W 5E4 NULL
  1. 当col时分成两个。 D =范围,(第2行(旧表))
  2. 当D& F是范围,(第3行和第4行(旧表))
  3. 仅当F为范围时取平均值。 (第5和第6行(旧表))
  4. 另外请忽略。 (第1行(旧表))
  5. 编辑:

    这是我尝试编码的方式:

      A              B       C      D       E    F       G        H     
    9/9/2015 9:54    500    glass   2       1   590     ABC 123 NULL
    6/8/2015 8:55    501    glass   3       1   400     XYZ 259 NULL
    6/8/2015 8:55    501    glass   4       1   500     XYZ 259 NULL
    5/8/2015 8:55    502    glass   1       1   675     ABC 123 NULL
    5/8/2015 8:55    502    glass   2       1   750     ABC 123 NULL     
    1/11/2015 9:55   503    glass   Base    1   425     ABC 123 NULL
    1/11/2015 9:55   503    glass   2       1   575     ABC 123 NULL
    1/1/2015  8:55   504    glass   3       2   1040    ABC 123 NULL
    16/1/2015 9:55   505    glass   2       2   1700    ABC 123 NULL
    

    似乎有些搞砸了。我没有得到理想的结果。我无法复制该行的其他值。

    非常感谢任何帮助。 提前谢谢。

1 个答案:

答案 0 :(得分:0)

我认为最简单的方法是创建一个全新的工作表,根据需要添加行。

这样的事情应该有效:

  Dim ws1, ws2 As Worksheet
  Dim row2 As Integer
  Dim rw As Range
  Dim dv, fv As Variant

  Set ws1 = Sheets("Sheet1")
  Set ws2 = Sheets.Add
  row2 = 1

  For Each rw In ws1.Rows
    If rw.Cells(1, 1).Value2 = "" Then
      Exit For
    End If

    dv = Split(rw.Cells(1, 4).Value2, " to ")
    fv = Split(rw.Cells(1, 6).Value2, " to ")

    ws2.Cells(row2, 1).EntireRow.Value = rw.Value

    If UBound(dv) = 0 Then
      If UBound(fv) = 1 Then
        ws2.Cells(row2, 6).Value2 = (Val(fv(0)) + Val(fv(1))) / 2
      End If
    Else
      ws2.Cells(row2, 4).Value2 = dv(0)
      ws2.Cells(row2, 6).Value2 = fv(0)
      row2 = row2 + 1
      ws2.Cells(row2, 1).EntireRow.Value = rw.Value
      ws2.Cells(row2, 4).Value2 = dv(1)
      ws2.Cells(row2, 6).Value2 = fv(UBound(fv))
    End If

    row2 = row2 + 1

  Next rw

然后,最后,只需将新工作表中的数据复制到旧工作表并删除新工作表。

  ws1.Rows("1:" & row2).Value = ws2.Rows("1:" & row2).Value

  Application.DisplayAlerts = False
  ws2.Delete
  Application.DisplayAlerts = True

- 2016年4月4日编辑 -

在回复您的评论时,我认为如果您想要拆分列F的值而不是平均值,那么您就会想要这样做。

我基本上劫持了我用来拆分D列的代码。

If UBound(dv) = 0 Then
  If UBound(fv) = 1 Then
    ws2.Cells(row2, 4).Value2 = dv(0)
    ws2.Cells(row2, 6).Value2 = fv(0)
    row2 = row2 + 1
    ws2.Cells(row2, 1).EntireRow.Value = rw.Value
    ws2.Cells(row2, 4).Value2 = dv(0)
    ws2.Cells(row2, 6).Value2 = fv(UBound(fv))
  End If
Else
  ws2.Cells(row2, 4).Value2 = dv(0)
  ws2.Cells(row2, 6).Value2 = fv(0)
  row2 = row2 + 1
  ws2.Cells(row2, 1).EntireRow.Value = rw.Value
  ws2.Cells(row2, 4).Value2 = dv(1)
  ws2.Cells(row2, 6).Value2 = fv(UBound(fv))
End If