將所有行移至第一個行

Question

我有100K的Excel文件，其中有許多員工信息，我想將所有存在的數據移至此員工的第一行，下面的圖片會比我的文字更響亮，可以使用VBA代碼做這個？或有Excel中的一個把戲，我不知道的

Answer 1

試試下面的代碼。

Sub Demo() 
    Dim ws As Worksheet 
    Dim cel As Range, rng As Range 
    Dim lastRow As Long, lastCol As Long, i As Long 
    Dim fOccur As Long, lOccur As Long, colIndex As Long 
    Dim dict As Object, c1 
    Application.ScreenUpdating = False 

    Set ws = ThisWorkbook.Sheets("Sheet1") 'change Sheet1 to your data range 
    Set dict = CreateObject("Scripting.Dictionary") 

    With ws 
     lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'last row with data in Column A 
     lastCol = .Cells.Find(What:="*", _ 
         After:=.Range("A1"), _ 
         Lookat:=xlPart, _ 
         LookIn:=xlFormulas, _ 
         SearchOrder:=xlByColumns, _ 
         SearchDirection:=xlPrevious, _ 
         MatchCase:=False).Column  'last column with data in Sheet1 

     Set rng = .Range("A1:A" & lastRow)    'set range in Column A 
     c1 = .Range("A2:A" & lastRow) 
     For i = 1 To UBound(c1, 1)      'using dictionary to get uniques values from Column A 
      dict(c1(i, 1)) = 1 
     Next i 

     colIndex = 16  'colIndex+1 is column number where data will be displayed from 
     For Each k In dict.keys  'loopthrough all unique values in Column A 
      fOccur = Application.WorksheetFunction.Match(k, rng, 0) 'get row no. of first occurrence 
      lOccur = Application.WorksheetFunction.CountIf(rng, k) 'get row no. of last occurrence 
      lOccur = lOccur + fOccur - 1 

      'copy range from left to right 
      .Range(.Cells(fOccur, 1 + colIndex), .Cells(lOccur, lastCol + colIndex)).Value = .Range(.Cells(fOccur, 1), .Cells(lOccur, lastCol)).Value 
      'delete blanks in range at right 
      .Range(.Cells(fOccur, 1 + colIndex), .Cells(lOccur, lastCol + colIndex)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp 'delte blank rows 
     Next k 
    End With 
    Application.ScreenUpdating = True 
End Sub 

Answer 2

嘗試以下。您可以修改以下代碼以匹配您要移動範圍的位置：

Dim oW As Worksheet: Set oW = ThisWorkbook.Worksheets("Sheet8") 

With oW.UsedRange 
    .Cut .Offset(0, .Columns.Count + 2) 
End With