в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:38Z

1 версия

Новая страница

==Array to rows==



<source lang="vb">

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
</source>

==Array to rows - method (Limited to ==



<source lang="vb">

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
</source>

==Bold cells in a Row==



<source lang="vb">

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
</source>

==change row height==



<source lang="vb">

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
</source>

==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.==



<source lang="vb">

Sub delete()
Rows("6:6").delete
End Sub
</source>

==Delete empty rows==



<source lang="vb">

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
</source>

==Get the last row and last cell==



<source lang="vb">

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
</source>

==Is in last row==



<source lang="vb">

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
</source>

==returns a number that represents the last nonempty cell in the same row==



<source lang="vb">

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
</source>

==Select active row==



<source lang="vb">

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
</source>

==Select entire row==



<source lang="vb">

Sub SelectEntireRow()
Selection.EntireRow.Select
End Sub
</source>

==Select first to last row==



<source lang="vb">

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
</source>

==Set the color row by row==



<source lang="vb">

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
</source>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Excel/Row - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия