یافتن ستون هایی با عرض معین

Question

هوارد نیاز به کشف تمام ستون های یک کاربرگ دارد که دارای عرض معین هستند. به عنوان مثال، او باید بداند که کدام ستون ها دارای عرض 3.6 هستند.

این را می توان با استفاده از ماکرو انجام داد. یکی از ویژگی هایی که ماکرو شما می تواند به آن دسترسی داشته باشد، عرض هر ستون است. این به این معنی است که می توانید از ستون ها عبور کرده و عرض ها را با عرض مورد نظر (3.6) به روش زیر بررسی کنید:

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

این ماکرو کادر پیامی را نمایش می دهد که ستون هایی را که با عرض مورد نظر مطابقت دارند فهرست می کند. ماکرو را می توان با برخی تغییرات ساده قوی تر کرد. به عنوان مثال، مثال زیر از کاربر می خواهد عرض ستون را بنویسد، تعداد تطابق ها را می شمارد، و حتی اگر کاربرگ از حالت ارجاع R1C1 استفاده می کند، جبران می کند.

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