在Excel中将一行分成两行

Question

根据行中某个标志的值，我有要求将一行分成两行。的结构如下： -

Exp_id Flag_1 guar_percent 
aaaa Y 20 
bbbb N 0 
cccc Y 100 
dddd Y 90 

在所有的上述的行，所有这些具有Flag_1为“Y”和guar_percent> 0，< 100是被分割到下面的行： - （I可以填充guar_percent列分割发生后之后）

Exp_id Flag_1 guar_percent 
aaaa_G Y 100 
aaaa_NG Y 0 
dddd_G Y 100 
dddd_NG Y 0 

感谢

Answer 1

如果你设置你的输入范围到一个数组，过程，它应该是一个相对简单的锻炼。下面的代码是全面的评论，但如果它没有意义，让我知道。

Option Explicit 

Sub SortData() 
    Dim vInData As Variant, vOutData As Variant 
    Dim ii As Long, lCounter As Long 
    Dim wkOut As Worksheet 

    'Read in your data, you could set this as a function and pass it any range 
    vInData = ActiveSheet.Range("A1:C8").Value2 

    'Double up the output array just in case every record is valid, we can redim after processing 
    'Also not we've transposed the array because you can only redim preserve the second bound 
    ReDim vOutData(LBound(vInData, 2) To UBound(vInData, 2), LBound(vInData, 1) To 2 * UBound(vInData, 1)) 

    'Loop through the input 
    For ii = LBound(vInData, 1) To UBound(vInData, 1) 
     'Check for the yes flag first 
     If vInData(ii, 2) = "Y" Then 
      'Then check the percentage bounds 
      If vInData(ii, 3) > 0 And vInData(ii, 3) < 100 Then 
       'Increase the counter by two since we're adding two lines. 
       lCounter = lCounter + 2 
       vOutData(1, lCounter - 1) = vInData(ii, 1) & "_G" 
       vOutData(2, lCounter - 1) = "Y" 
       vOutData(3, lCounter - 1) = 100 
       vOutData(1, lCounter) = vInData(ii, 1) & "_NG" 
       vOutData(2, lCounter) = "Y" 
       vOutData(3, lCounter) = 0 
      End If 
     End If 
    Next ii 

    'Now we have all the outputs redim the array to remove empty elements 
    ReDim Preserve vOutData(LBound(vOutData, 1) To UBound(vOutData, 1), LBound(vOutData, 2) To lCounter) 

    'I've just dumped the output onto a fresh sheet, you can set the output array to any range on any worksheet you like 
    Set wkOut = ThisWorkbook.Worksheets.Add 
    With wkOut 
     .Name = "Output" 
     .Range(.Cells(1, 1), .Cells(UBound(vOutData, 2), UBound(vOutData, 1))).Value2 = Application.WorksheetFunction.Transpose(vOutData) 
    End With 
End Sub 

Answer 2

这就是我所做的，它的工作。任何建议来优化它是受欢迎的。谢谢大家。

Sub SplitRec() 
    Dim getRow As Long 
    Dim LR As Long 
    Dim RowCount As Integer 

    For getRow = 1 To Worksheets("Sheet1").UsedRange.Rows.Count Step 1 

     If (Worksheets("Sheet1").Cells(getRow, 111).Value) > 0 And (Worksheets("Sheet1").Cells(getRow, 111).Value) < 1 Then 

      Worksheets("Sheet1").Rows(getRow).Copy Worksheets("Sheet2").Rows(Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 2).End(xlUp).Row + 1) 
      Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Value = Worksheets("Sheet1").Range("A" & getRow).Value + "_G" 

      Worksheets("Sheet1").Rows(getRow).Copy Worksheets("Sheet2").Rows(Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 2).End(xlUp).Row + 1) 
      Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Value = Worksheets("Sheet1").Range("A" & getRow).Value + "_NG" 

     Else 
      RowCount = RowCount + 1 

      Worksheets("Sheet1").Rows(getRow).Copy Worksheets("Sheet2").Rows(Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 2).End(xlUp).Row + 1) 
      Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Value = Worksheets("Sheet1").Range("A" & getRow).Value 

     End If 
    Next 

End Sub