VBA/Excel/Access/Word/Excel/Cells
Версия от 16:33, 26 мая 2010; (обсуждение)
Содержание
- 1 Calling CurrentRegion to Inspect a List"s Useful Characteristics
- 2 Cells.Find: Get Real Last Cell
- 3 Cells(Rows.Count, "A").End(xlUp).Select
- 4 Entering a value in the next empty cell
- 5 Get cell value
- 6 looping through a worksheet range using a For/Next loop.
- 7 Set cell value with For Loop
- 8 Sum Cells Based on the Interior Color
- 9 Use row and column index to reference cell
- 10 Use the AutoFill function by specifying the destination range
- 11 Using Replace Programmatically to Set the Correct Range
Calling CurrentRegion to Inspect a List"s Useful Characteristics
Sub CurrentRegionExample()
Dim rg As Range
Dim myWorksheet As Worksheet
Set myWorksheet = ThisWorkbook.Worksheets("Sheet1")
Set rg = myWorksheet.Cells(1, 1).CurrentRegion
myWorksheet.Range("I2").Value = rg.ListHeaderRows
myWorksheet.Range("I3").Value = rg.Columns.Count
Set rg = rg.Resize(rg.Rows.Count - rg.ListHeaderRows,rg.Columns.Count).Offset(1, 0)
Debug.Print rg.Rows.Count
Debug.Print rg.Cells.Count
Debug.Print Application.WorksheetFunction.CountBlank(rg)
Debug.Print Application.WorksheetFunction.Count(rg)
Debug.Print rg.Rows.Count + rg.Cells(1, 1).Row - 1
Set rg = Nothing
Set myWorksheet = Nothing
End Sub
Cells.Find: Get Real Last Cell
Public Sub GetRealLastCell()
Dim realastRow As Long
Dim realastColumn As Long
Range("A1").Select
On Error Resume Next
realastRow = Cells.Find("*", Range("A1"),xlFormulas, , xlByRows, xlPrevious).Row
realastColumn = Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
Cells(realastRow, realastColumn).Select
End Sub
Cells(Rows.Count, "A").End(xlUp).Select
Sub EndUp()
Cells(Rows.Count, "A").End(xlUp).Select
End Sub
Entering a value in the next empty cell
Sub GetData()
Do
NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Entry1 = "A"
Entry2 = "B"
Cells(NextRow, 1) = Entry1
Cells(NextRow, 2) = Entry2
Loop
End Sub
Get cell value
Sub cellValue()
Dim num1 As Integer
Dim num2 As Integer
num1 = Cells(1, 1).Value
num2 = Cells(1, 2).Value
Dim result As Boolean
result = (num1 <= 10) And (num2 <> 50)
Debug.Print result
End Sub
looping through a worksheet range using a For/Next loop.
Sub NestedFor()
Dim I As Integer
Dim J As Integer
For I = 1 To 10
For J = 4 To 7
Cells(I, Chr(J + 64)).Value = I * J
Next J
Next I
End Sub
Set cell value with For Loop
Sub RangeObjects()
Dim i As Integer, j As Integer
For i = 1 To 10
For j = 1 To 5
Cells(i, j).Value = i * j
Next j
Next i
End Sub
Sum Cells Based on the Interior Color
Function SumByColor(CellColor As Range, SumRange As Range)
Dim myCell As Range
Dim iCol As Integer
Dim myTotal
iCol = CellColor.Interior.ColorIndex
For Each myCell In SumRange
If myCell.Interior.ColorIndex = iCol Then
myTotal = WorksheetFunction.Sum(myCell) + myTotal
End If
Next myCell
SumByColor = myTotal
End Function
Use row and column index to reference cell
Sub ReferAcrossWorksheets3()
Range(Sheets("Sheet1").Cells(1, 1), Sheets("Sheet1").Cells(10, 5)).Font.Bold = True
End Sub
Use the AutoFill function by specifying the destination range
Sub autoFillRange()
Cells(2, "B").autoFill Destination:=Range("B2:B10")
End Sub
Using Replace Programmatically to Set the Correct Range
Sub ReplaceExample()
Dim ws As Worksheet
Dim rg As Range
Dim lLastRow As Long
Set ws = ThisWorkbook.Worksheets("Replace Examples")
lLastRow = ws.Cells(65536, 1).End(xlUp).Row
Set rg = ws.Range(ws.Cells(2, 2), ws.Cells(lLastRow, 3))
rg.Replace "", "UNKNOWN"
Set rg = ws.Range(ws.Cells(2, 4), ws.Cells(lLastRow, 4))
rg.Replace "", "0"
Set rg = Nothing
Set ws = Nothing
End Sub