0

サブの最初の部分(ヘッダーリストの列に作用する)を他の種類のアクションに適用する方法を見つけようとしています(オリジナルはリストの列を削除するように設定されていました)。

私の試みは、リストにいくつかの単純なフォーマットを適用するという点でほとんどうまくいきます：「RespID、Score」

ただし、サブはリスト「RespID」の最初の項目にのみ適用されます

サブで変更したのは、'~~> 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
4

1 に答える 1

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

次の 3 つの点に注意してください。

  1. の「スコア」の前にスペースはありませんColList。それ以外の場合、Split関数は名前の前にスペースを追加し、列見出しに実際のスペースがない限り見つかりません (実際には、それが根本的な問題かもしれません)。
  2. MsgBox を使用して正しい列が検出されることを示しているだけです。これは、書式設定するセルを特定することとまったく同じではありません (ただし、ほとんどの場合はそこに到達します)。
  3. フォーマットする最後のセルが何であるかを把握する必要があります。列全体をフォーマットしたい場合は、うまくいくWith colToFormatはずです。

上記はあなたのやり方に役立つはずだと思います。覚えておいてください - コードをシンプルに保ちましょう。また、他人のコードを使用する場合は十分に注意してください...

于 2013-09-01T18:48:59.723 に答える