VBA/Excel/Access/Word/Excel/Cells

Материал из VB Эксперт
Версия от 12:47, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

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