Public Sub CopyModelHideBlankRows()
AppSettings
Dim StartTime As Variant
Dim UsedTime As Variant
StartTime = VBA.Timer
Dim RngAddress As String, Rng As Range, Sht As Worksheet, URows As Range
Dim RngRow As Long, RngCol As Long, FirstRow As Long
Const MaxRow As Long = 57
Set Sht = Application.ActiveSheet
With Sht
On Error Resume Next
Set Rng = Application.InputBox("请选择2号所在的区域", "QQ 84857038", , , , , , 8)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub
RngRow = Rng.Rows.Count
RngCol = Rng.Columns.Count
FirstRow = Rng.Cells(1, 1).Row
If RngRow < MaxRow Then
Rng.Cells(1, 1).Resize(MaxRow - RngRow, 1).EntireRow.Insert
End If
Set Rng = .Cells(FirstRow, "A").Resize(MaxRow, RngCol)
Debug.Print Rng.Address
For i = 3 To 31
EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 1
Rng.Copy .Cells(EndRow, 1)
Next i
EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
For i = 1 To EndRow
If Application.WorksheetFunction.CountA(.Rows(i)) = 0 Then
If URows Is Nothing Then
Set URows = .Rows(i)
Else
Set URows = Union(URows, .Rows(i))
End If
End If
Next i
If Not URows Is Nothing Then
URows.EntireRow.Hidden = True
End If
End With
UsedTime = VBA.Timer - StartTime
' Debug.Print "UsedTime ：" & Format(UsedTime, "#0.0000 Seconds")
MsgBox "UsedTime ：" & Format(UsedTime, "#0.0000 Seconds")
AppSettings False
End Sub
Public Sub AppSettings(Optional IsStart As Boolean = True)
Application.ScreenUpdating = IIf(IsStart, False, True)
Application.DisplayAlerts = IIf(IsStart, False, True)
Application.Calculation = IIf(IsStart, xlCalculationManual, xlCalculationAutomatic)
Application.StatusBar = IIf(IsStart, ">>>>>>>>Macro Is Running>>>>>>>>", False)
End Sub
