Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/16.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 根据列标题格式化列_Excel_Vba - Fatal编程技术网

Excel 根据列标题格式化列

Excel 根据列标题格式化列,excel,vba,Excel,Vba,我正在尝试编写一个宏,它根据列标题更改单元格的格式 标题_2需要是适当的情况, 标题_3必须是大写, 所有列标题都需要大写 我过度简化了示例,但实际上我有80列,平均3000行,列中有空格,因此宏需要在我不选择或指定范围的情况下运行 下面是我迄今为止的代码——尽管我不断遇到“不匹配”错误(不确定如何修复) 提前感谢您提供的任何见解或帮助 以下是我的数据: 试试这个 Public Sub Proper_text() Dim ws As Worksheet, ur As Range, fr

我正在尝试编写一个宏,它根据列标题更改单元格的格式

标题_2需要是适当的情况, 标题_3必须是大写, 所有列标题都需要大写

我过度简化了示例,但实际上我有80列,平均3000行,列中有空格,因此宏需要在我不选择或指定范围的情况下运行

下面是我迄今为止的代码——尽管我不断遇到“不匹配”错误(不确定如何修复)

提前感谢您提供的任何见解或帮助

以下是我的数据:

试试这个

Public Sub Proper_text()
    Dim ws As Worksheet, ur As Range, fr As Long, lr As Long, lc As Long, x As Range

    Set ws = ActiveSheet
    Set ur = ws.UsedRange
    fr = ur.Row
    lr = ur.Row + ur.Rows.Count - 1
    lc = ur.Column + ur.Columns.Count - 1

    Application.ScreenUpdating = False

    For Each x In ur.Range(ur.Cells(fr, ur.Column), ur.Cells(fr, lc))
        x.Offset(, lc).Formula = "=UPPER(" & x.Address(False, False) & ")"
    Next

    For Each x In ur.Range(ur.Cells(fr + 1, ur.Column), ur.Cells(fr + 1, lc))

        If UCase(x.Offset(-1).Value2) = "HEADER_2" Then
            x.Offset(, lc).Formula = "=PROPER(" & x.Address(False, False) & ")"
        Else
            x.Offset(, lc).Formula = "=UPPER(" & x.Address(False, False) & ")"
        End If

    Next

    Set x = ws.Range(ws.Cells(fr + 1, lc + 1), ur.Cells(fr + 1, lc * 2))
    x.AutoFill Destination:=ur.Range(ur.Cells(fr + 1, lc + 1), ur.Cells(lr, lc * 2))

    ur.Range(ur.Cells(fr, lc + 1), ur.Cells(lr, lc * 2)).Copy
    ur.Range(ur.Cells(fr, ur.Column), ur.Cells(lr, lc)).PasteSpecial Paste:=xlPasteValues

    ur.Range(ur.Cells(fr, lc + 1), ur.Cells(fr, lc * 2)).EntireColumn.Delete

    Application.ScreenUpdating = True
    ws.Cells(1).Select
End Sub

结果

Before:                                     After:

HEAser_1    HEADer_2    heaDER_3            HEASER_1    HEADER_2    HEADER_3
--------    --------    --------            --------    --------    --------
    1       sTphn       pRCELL               1          Stphn       PRCELL
    2       ADIL        mlr                  2          Adil        MLR
    3       Mlling      sNN                  3          Mlling      SNN
    4       Rosemary    Irvine               4          Rosemary    IRVINE
    5                                        5
    6       JIA         pAn                  6          Jia         PAN
    7       MAJID       doost                7          Majid       DOOST
    8       WILLIAM     smith                8          William     SMITH
    9                                        9
   10       VIssUT      domklAng             10         Vissut      DOMKLANG
   11       RoDNy       mCdermid             11         Rodny       MCDERMID
   12       RoBrt       pACker               12         Robrt       PACKER
   13       PAUL        retz                 13         Paul        RETZ
   14       TRoY        mACpherson           14         Troy        MACPHERSON
   15       CATHRYN     stAfford             15         Cathryn     STAFFORD
Before:                                     After:

HEAser_1    HEADer_2    heaDER_3            HEASER_1    HEADER_2    HEADER_3
--------    --------    --------            --------    --------    --------
    1       sTphn       pRCELL               1          Stphn       PRCELL
    2       ADIL        mlr                  2          Adil        MLR
    3       Mlling      sNN                  3          Mlling      SNN
    4       Rosemary    Irvine               4          Rosemary    IRVINE
    5                                        5
    6       JIA         pAn                  6          Jia         PAN
    7       MAJID       doost                7          Majid       DOOST
    8       WILLIAM     smith                8          William     SMITH
    9                                        9
   10       VIssUT      domklAng             10         Vissut      DOMKLANG
   11       RoDNy       mCdermid             11         Rodny       MCDERMID
   12       RoBrt       pACker               12         Robrt       PACKER
   13       PAUL        retz                 13         Paul        RETZ
   14       TRoY        mACpherson           14         Troy        MACPHERSON
   15       CATHRYN     stAfford             15         Cathryn     STAFFORD