从列表中的删除列更改宏以从列表中格式化列,几乎正常工作

时间:2013-09-01 16:19:17

标签: excel excel-vba vba

我试图找出如何将Sub的第一部分(对标题列表中的列进行操作)应用于其他类型的操作(原始设置为删除列表中的列)。

我的尝试几乎起作用,它将一些简单的格式应用于列表:“RespID,Score”

但Sub只是应用于“RespID”列表中的第一项

我在Sub中唯一改变的是在'~~> Act on columns

之后的底部

谢谢

Sub FormatRespIDScore360()
Dim WS As Worksheet
Dim ColList As String, ColArray() As String
Dim lastCol As Long, i As Long, j As Long
Dim boolFound As Boolean
Dim delCols As Range
Dim lastRow As Long

On Error GoTo Whoa

Application.ScreenUpdating = False

Set WS = Sheets("360")

ColList = "RespID, Score"

ColArray = Split(ColList, ",")

'~~> Get the last column
lastCol = WS.Cells.Find(What:=" ", After:=WS.Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False).Column

For i = 1 To lastCol
    boolFound = False
    '~~> Checking of the current cell value is present in the array
    For j = LBound(ColArray) To UBound(ColArray)
        If UCase(Trim(WS.Cells(1, i).Value)) = UCase(Trim(ColArray(j))) Then
            '~~> Match Found
            boolFound = True
            Exit For
        End If
    Next
   '~~> If not match not found
    If boolFound = True Then
        If delCols Is Nothing Then
            Set delCols = WS.Columns(i)
        Else
            Set delCols = Union(delCols, WS.Columns(i))
        End If
    End If
Next i

'~~> Act on columns
If Not delCols Is Nothing Then

    With Sheets(1)
        lastRow = .Cells(.Rows.Count, delCols.Column).End(xlUp).Row
    End With


    With Sheets(1).Range(delCols, WS.Cells(lastRow, delCols.Column))

            .NumberFormat = "0"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False

        End With

    End If
LetsContinue:
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub

1 个答案:

答案 0 :(得分:1)

这已经找到了一种非常简单的做事的相当复杂的方法!我在线的关键问题是:

With Sheets(1).Range(delCols, WS.Cells(lastRow, delCols.Column))

您确实希望将格式应用于具有特定标题的列 - 您应该找出这些列的内容,并将格式应用于它们。从一个非常简单的例子开始:

Dim colToFormat as Range
set colToFormat = Range("A1", "B25");

With colToFormat
    .NumberFormat = "0"
End With

这应该是代码的本质。现在,您需要找出要替换"A1""B25"的内容。你已经知道了标题 - 所以为什么不在纸上寻找它们。

Sub fmt()
    ColList = "RespID,Score"
    colarray = Split(ColList, ",")
    Set colToFormat = Nothing
    For Each heading In colarray
    Set headingFound = Range("A:A").Offset(0, ActiveSheet.Cells.Find(What:=heading, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Column - 2)

      If colToFormat Is Nothing Then Set colToFormat = headingFound Else Set colToFormat = Union(colToFormat, headingFound)
    Next
    MsgBox colToFormat.Address

End Sub

需要注意三点:

  1. ColList中的“得分”前没有空格。 Split函数否则会在名称前添加一个空格,除非列标题中有实际空格(实际上这可能是您的根本问题),否则将无法找到它。
  2. 我只是显示使用MsgBox找到了正确的列 - 这与确定要格式化的单元格并不完全相同(但它可以让你大部分都在那里)。
  3. 您必须弄清楚要格式化的最后一个单元格是什么。如果要格式化整个列,则With colToFormat应该有效。
  4. 我认为以上内容可以帮助您。记住 - 保持你的代码简单,否则你将无法理解你在三个月内所做的事情。使用别人的代码要非常小心......