VBA/Excel/Access/Word/Excel/Cell Value

Материал из VB Эксперт
Перейти к: навигация, поиск

Assing value in Cells to array, do the bubble sort and assign them back

   <source lang="vb">

Public Sub BubbleSort2()

   Dim tempVar As Integer
   Dim anotherIteration As Boolean
   Dim I As Integer
   Dim myArray(10) As Integer
   For I = 1 To 10
       myArray(I - 1) = Cells(I, "A").Value
   Next I
   Do
       anotherIteration = False
       For I = 0 To 8
           If myArray(I) > myArray(I + 1) Then
               tempVar = myArray(I)
               myArray(I) = myArray(I + 1)
               myArray(I + 1) = tempVar
               anotherIteration = True
           End If
       Next I
   Loop While anotherIteration = True
   For I = 1 To 10
       Cells(I, "B").Value = myArray(I - 1)
   Next I

End Sub

</source>
   
  


Calculate cell

   <source lang="vb">

Sub CalcCell()

     Worksheets("Sheet1").range("A1").Calculate

End Sub

</source>
   
  


Checks values in a range 10 rows by 5 columns

   <source lang="vb">

Sub CheckValues1()

   Dim rwIndex As Integer
   Dim colIndex As Integer
   For rwIndex = 1 To 10
           For colIndex = 1 To 5
               If Cells(rwIndex, colIndex).Value <> 0 Then _
                   Cells(rwIndex, colIndex).Value = 0
           Next colIndex
   Next rwIndex

End Sub

</source>
   
  


Checks values in a range 10 rows by 5 columns with nested for loop

   <source lang="vb">

Sub CheckValues2()

   Dim rwIndex As Integer
   Dim colIndex As Integer
   For rwIndex = 1 To 10
        For colIndex = 1 To 5
            With Cells(rwIndex, colIndex)
                If Not (.Value = 0) Then Cells(rwIndex, colIndex).Value = 0
            End With
        Next colIndex
   Next rwIndex

End Sub

</source>
   
  


Define a string type variable and set to Cell(1,D)

   <source lang="vb">

Sub Strtype()

   Dim myHeading As String
   myHeading = "asdf"
   Cells(1, "D").Value = myHeading

End Sub

</source>
   
  


Determining a cell"s data type

   <source lang="vb">

Function CellType(Rng)

   Application.Volatile
   Set Rng = Rng.Range("A1")
   Select Case True
       Case IsEmpty(Rng)
           CellType = "Blank"
       Case WorksheetFunction.IsText(Rng)
           CellType = "Text"
       Case WorksheetFunction.IsLogical(Rng)
           CellType = "Logical"
       Case WorksheetFunction.IsErr(Rng)
           CellType = "Error"
       Case IsDate(Rng)
           CellType = "Date"
       Case InStr(1, Rng.Text, ":") <> 0
           CellType = "Time"
       Case IsNumeric(Rng)
           CellType = "Value"
   End Select

End Function

</source>
   
  


Format("ALL LOWERCASE ", "

   <source lang="vb">

Sub callLower()

   Cells(2, "A").Value = Format("ALL LOWERCASE ", "<")

End Sub

</source>
   
  


Place the value (result) of a formula into a cell rather than the formula.

   <source lang="vb">

Sub GetSum() " using the shortcut approach

   [A1].Value = Application.Sum([E1:E15])

End Sub

</source>
   
  


StrConv("ALL LOWERCASE ", vbLowerCase)

   <source lang="vb">

Sub STRConvDemo()

   Cells(3, "A").Value = STRConv("ALL LOWERCASE ", vbLowerCase)

End Sub

</source>
   
  


transposes the values of a group of cells in a worksheet

   <source lang="vb">

Public Sub Transpose()

   Dim I As Integer
   Dim J As Integer
   Dim transArray(9, 2) As Integer
   For I = 1 To 3
       For J = 1 To 10
           transArray(J - 1, I - 1) = Cells(J, Chr(I + 64)).Value
       Next J
   Next I
   Range("A1:C10").ClearContents
   For I = 1 To 3
       For J = 1 To 10
           Cells(I, Chr(J + 64)).Value = transArray(J - 1, I - 1)
       Next J
   Next I

End Sub

</source>
   
  


Validation with a Spreadsheet Cell

   <source lang="vb">

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim cellContents As String
   Dim valLength As Integer
   cellContents = Trim(Str(Val(Target.Value)))
   valLength = Len(cellContents)
   If valLength <> 3 Then
       MsgBox ("Please enter a 3 digit area code.")
       Cells(9, "C").Select
   Else
       Cells(9, "C").Value = cellContents
       Cells(9, "D").Select
   End If

End Sub

</source>