VBA/Excel/Access/Word/Excel/Column — различия между версиями

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

Версия 19:33, 26 мая 2010

Adjusting Column Widths

   <source lang="vb">

Sub AdjustColumns()

   Dim ws As Worksheet
   On Error Resume Next
   Set ws = ThisWorkbook.Worksheets("Sheet1")
   ws.Columns.ColumnWidth = 12
   Set ws = Nothing

End Sub

</source>
   
  


Array to Columns

   <source lang="vb">

Sub ArrayToColumns()

   Dim MyArray()
   Dim Cols As Integer
   Cols = 5
   ReDim MyArray(1 To Cols)
   Cells.Clear
   i = 1
   For c = 1 To Cols
       MyArray(c) = i
       i = i + 1
   Next c
   Range(Cells(1, 1), Cells(1, Cols)) = MyArray

End Sub

</source>
   
  


Assign the column width of one cell to another cell on the active sheet, using:

   <source lang="vb">

Sub widthDemo()

    Range("C1").ColumnWidth = Range("A1").ColumnWidth

End Sub

</source>
   
  


Assign the value to the ColumnWidth property of the ActiveCell using:

   <source lang="vb">

Sub colDemo()

    ActiveCell.ColumnWidth = 20

End Sub

</source>
   
  


Change column width

   <source lang="vb">

Private Sub ChangeColumnWidth(Width As Variant)

   If IsNumeric(Width) Then 
       If Width > 0 And Width < 100 Then 
           Me.Columns.ColumnWidth = Width 
       ElseIf Width = 0 Then 
           Me.Columns.ColumnWidth = Me.StandardWidth 
       End If 
   End If 

End Sub

</source>
   
  


ClearContents method deletes the contents of the range but leaves the formatting intact.

   <source lang="vb">

Sub content()

   Columns("D:D").ClearContents

End Sub

</source>
   
  


ClearFormats method deletes the formatting in the range but not the cell contents.

   <source lang="vb">

Sub format()

   Columns("D:D").ClearFormats

End Sub

</source>
   
  


converts the Integer to a String representation of the same column.

   <source lang="vb">

Sub Main()

  Debug.Print GetColumnRef(3)

End Sub Function GetColumnRef(columnIndex As Integer) As String

   Dim numAlpha As Integer
   Dim firstLetter As String
   Dim secondLetter As String
   Dim remainder As Integer
   numAlpha = columnIndex \ 26
   Select Case columnIndex / 26
       Case Is <= 1      "Column ref is between A and Z
           firstLetter = Chr(columnIndex + 64)
           GetColumnRef = firstLetter
       Case Else      "Column ref has two letters
           remainder = columnIndex - 26 * (columnIndex \ 26)
           If remainder = 0 Then
               firstLetter = Chr(64 + (columnIndex \ 26) - 1)
               secondLetter = "Z"
               GetColumnRef = firstLetter & secondLetter
           Else
               firstLetter = Chr(64 + (columnIndex \ 26))
               secondLetter = Chr(64 + remainder)
               GetColumnRef = firstLetter & secondLetter
           End If
   End Select

End Function

</source>
   
  


Is in last column

   <source lang="vb">

Function LASTINCOLUMN(rngInput As Range)

   Dim WorkRange As Range
   Dim i As Integer, CellCount As Integer
   Application.Volatile
   Set WorkRange = rngInput.Columns(1).EntireColumn
   Set WorkRange = Intersect(WorkRange.Parent.UsedRange, WorkRange)
   CellCount = WorkRange.Count
   For i = CellCount To 1 Step -1
       If Not IsEmpty(WorkRange(i)) Then
           LASTINCOLUMN = WorkRange(i).Value
           Exit Function
       End If
   Next i

End Function

</source>
   
  


Make a range autofit

   <source lang="vb">

Sub autofit()

   range("A1:G1").Columns.autofit

End Sub

</source>
   
  


Returning the Last Used Cell in a Column or Row with Worksheet

   <source lang="vb">

Function GetLastUsedRow(rg As Range) As Long

   Dim lMaxRows As Long 
   lMaxRows = ThisWorkbook.Worksheets(1).Rows.Count 
   If IsEmpty(rg.Parent.Cells(lMaxRows, rg.Column)) Then 
       GetLastUsedRow = _ 
           rg.Parent.Cells(lMaxRows, rg.Column).End(xlUp).Row 
   Else 
       GetLastUsedRow = rg.Parent.Cells(lMaxRows, rg.Column).Row 
   End If 

End Function

</source>
   
  


Select active column

   <source lang="vb">

Sub SelectActiveColumn()

   If IsEmpty(ActiveCell) Then Exit Sub
   On Error Resume Next
   If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp)
   If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown)
   Range(TopCell, BottomCell).Select

End Sub

</source>
   
  


Select entire column

   <source lang="vb">

Sub SelectEntireColumn()

   Selection.EntireColumn.Select

End Sub

</source>
   
  


Select first column to last column

   <source lang="vb">

Sub SelectFirstToLastInColumn()

   Set TopCell = Cells(1, ActiveCell.Column)
   Set BottomCell = Cells(16384, ActiveCell.Column)
   If IsEmpty(TopCell) Then Set TopCell = TopCell.End(xlDown)
   If IsEmpty(BottomCell) Then Set BottomCell = BottomCell.End(xlUp)
   If TopCell.Row = 16384 And BottomCell.Row = 1 Then ActiveCell.Select Else Range(TopCell, BottomCell).Select

End Sub

</source>
   
  


The BubbleSort() procedure sorts a column of integer values from lowest to highest value

   <source lang="vb">

Public Sub BubbleSort()

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

End Sub

</source>
   
  


The Clear method

   <source lang="vb">

Sub clear()

   Columns("D:D").clear

End Sub

</source>
   
  


The NumberFormat property represents the number format (expressed as a text string) of the Range object: statement changes the number format of column A to percent with two decimal places

   <source lang="vb">

Sub numFormat()

   Columns("A:A").NumberFormat = "0.00%"

End Sub

</source>