Tìm các cột có độ rộng nhất định (Microsoft Excel)

Sub ListColumns()

Dim dColWidth As Double     Dim sMsg As String     Dim x As Integer

dColWidth = 3.6     sMsg = ""

For x = 1 To ActiveSheet.Columns.Count         If Columns(x).ColumnWidth = dColWidth Then             sMsg = sMsg & vbCrLf & x         End If     Next     If sMsg = "" Then         sMsg = "There are no columns with" & _           vbCrLf & "a width of " & dColWidth     Else         sMsg = "The following columns have" & _           vbCrLf & "a width of " & dColWidth & _           ":" & vbCrLf & sMsg     End If     MsgBox sMsg End Sub

Sub Find_ColumnWidth()

Dim Col As Integer          ' Column (loop variable)

Dim ColsFound As Integer    ' Columns Found Count     Dim Desired_Width As Double ' Column Width To Find     Dim OutStr As String        ' Output String     Dim Title As String         ' Msgbox Title     Dim I As Integer     Dim S As String

' Find out column width wanted     S = InputBox("Enter ColumnWidth to find ?", _       " Find ColumnWidth on " & ActiveSheet.Name)

Desired_Width = Val(S)

If Desired_Width = 0 Then Exit Sub

' Initialize Columns Found Count and Output String     ColsFound = 0     OutStr = ""



For Col = 1 To ActiveSheet.Columns.Count         If Columns(Col).ColumnWidth = Desired_Width Then             ColsFound = ColsFound + 1

If Application.ReferenceStyle = 1 Then                 ' Using "A1" format                 S = Cells(1, Col).Address(ReferenceStyle:=xlA1)

S = Mid(S, 2, Len(S) - 3)

Else                 ' Using "R1C1" format                 S = Trim(Str(Col))

End If             OutStr = OutStr & S & vbCrLf         End If     Next

' Construct MsgBox Title string     Title = "Width=" & Desired_Width _       & " on " & ColsFound & " column" _       & Left("s", - (ColsFound > 1)) & " "



If ColsFound = 0 Then         OutStr = "No matches found"

End If

MsgBox OutStr, vbOKOnly, Title End Sub