在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