VBA/Excel/Access/Word/Excel/Row
Версия от 16:33, 26 мая 2010; (обсуждение)
Содержание
- 1 Array to rows
- 2 Array to rows - method (Limited to
- 3 Bold cells in a Row
- 4 change row height
- 5 Clearing a range differs from deleting a range. When you delete a range, Excel shifts the remaining cells around to fill up the range you deleted.
- 6 Delete empty rows
- 7 Get the last row and last cell
- 8 Is in last row
- 9 returns a number that represents the last nonempty cell in the same row
- 10 Select active row
- 11 Select entire row
- 12 Select first to last row
- 13 Set the color row by row
Array to rows
Sub ArrayToRows1()
Dim MyArray()
Dim Rows As Long
Rows = 5200
ReDim MyArray(1 To Rows)
Cells.Clear
i = 1
For r = 1 To Rows
MyArray(r) = i
i = i + 1
Next r
Range(Cells(1, 1), Cells(Rows, 1)) = _
Application.Transpose(MyArray)
End Sub
Array to rows - method (Limited to
Sub ArrayToRows2()
Dim Rows As Long
Dim MyArray()
Rows = 65536
ReDim MyArray(1 To Rows, 0 To 0)
Cells.Clear
i = 1
For r = 1 To Rows
MyArray(r, 0) = i
i = i + 1
Next r
Range(Cells(1, 1), Cells(Rows, 1)) = MyArray
End Sub
Bold cells in a Row
Public Sub BoldCells()
Dim Row As Object
For Each Row In Range("SalesData").Rows
If Row.Cells(1).Value > 1000 Then
Row.Font.Bold = True
Else
Row.Font.Bold = False
End If
Next Row
End Sub
change row height
Private Sub ChangeRowHeight(Height As Variant)
If IsNumeric(Height) Then
If Height > 0 And Height < 100 Then
Me.Rows.RowHeight = Height
ElseIf Height = 0 Then
Me.Rows.RowHeight = Me.StandardHeight
End If
End If
End Sub
Clearing a range differs from deleting a range. When you delete a range, Excel shifts the remaining cells around to fill up the range you deleted.
Sub delete()
Rows("6:6").delete
End Sub
Delete empty rows
Sub DeleteEmptyRows()
Dim rngRow As Range
For Each rngRow In ActiveSheet.UsedRange.Rows
If WorksheetFunction.CountA(rngRow) = 0 Then
rngRow.EntireRow.Delete
End If
Next rngRow
End Sub
Get the last row and last cell
Sub LastCell()
Dim rngLast As Range
Dim LastRow As Long, LastCol As Long
Set rngLast = Range("A1").SpecialCells(xlCellTypeLastCell)
LastRow = rngLast.Row
LastCol = rngLast.Column
MsgBox LastRow & " " & LastCol
End Sub
Is in last row
Function LASTINROW(rngInput As Range) As Variant
Dim WorkRange As Range
Dim i As Integer, CellCount As Integer
Application.Volatile
Set WorkRange = rngInput.Rows(1).EntireRow
Set WorkRange = Intersect(WorkRange.Parent.UsedRange, WorkRange)
CellCount = WorkRange.Count
For i = CellCount To 1 Step -1
If Not IsEmpty(WorkRange(i)) Then
LASTINROW = WorkRange(i).Value
Exit Function
End If
Next i
End Function
returns a number that represents the last nonempty cell in the same row
Function GetLastUsedColumn(rg As Range) As Long
Dim lMaxColumns As Long
lMaxColumns = ThisWorkbook.Worksheets(1).Columns.Count
If IsEmpty(rg.Parent.Cells(rg.Row, lMaxColumns)) Then
GetLastUsedColumn = _
rg.Parent.Cells(rg.Row, lMaxColumns).End(xlToLeft).Column
Else
GetLastUsedColumn = rg.Parent.Cells(rg.Row, lMaxColumns).Column
End If
End Function
Select active row
Sub SelectActiveRow()
If IsEmpty(ActiveCell) Then Exit Sub
On Error Resume Next
If IsEmpty(ActiveCell.Offset(0, -1)) Then Set LeftCell = ActiveCell Else Set LeftCell = ActiveCell.End(xlToLeft)
If IsEmpty(ActiveCell.Offset(0, 1)) Then Set RightCell = ActiveCell Else Set RightCell = ActiveCell.End(xlToRight)
Range(LeftCell, RightCell).Select
End Sub
Select entire row
Sub SelectEntireRow()
Selection.EntireRow.Select
End Sub
Select first to last row
Sub SelectFirstToLastInRow()
Set LeftCell = Cells(ActiveCell.Row, 1)
Set RightCell = Cells(ActiveCell.Row, 256)
If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End(xlToRight)
If IsEmpty(RightCell) Then Set RightCell = RightCell.End(xlToLeft)
If LeftCell.Column = 256 And RightCell.Column = 1 Then ActiveCell.Select Else Range(LeftCell, RightCell).Select
End Sub
Set the color row by row
Sub ColorCells3()
Dim myRange As Range
Dim i As Long
Set myRange = Range("A1:E5")
For i = 1 To myRange.Cells.Count
If myRange(i).Value < 100 Then
myRange(i).Font.ColorIndex = 6
Else
myRange(i).Font.ColorIndex = 1
End If
Next i
End Sub