excel - 根据标题格式化一系列列 - Excel

Question

我有解决方案的一部分，但它没有像我希望的那样工作，所以我来找你寻求建议。

我经常收到需要修改格式的 Excel 文件。我试图通过尽可能多地自动化这些过程来学习 VBA。

我完成的一种特殊格式是将日期转换为“DDMMYYYY”(09091986)，通常为 09/09/1986。

在我的工作表中，共有 3 列包含日期，所有这些都需要相同的格式，并且所有这些都在标题中包含“DATE”一词。它们彼此不相邻。

我还必须小心不要影响任何其他数据，因为我的姓名和地址可能包含字符“DATE”。

所以，背景不碍事......我正在尝试搜索第一行，直到找到“日期”这个词，然后为每个单元格设置格式，直到最后一行，然后再转到包含“日期”这个词的下一列DATE”并重复此操作，直到所有带有单词“DATE”的列都已格式化。

我确定您有一个简单的解决方案，但我自己似乎找不到。

这是我的代码...

Sub Dateformat()
    Dim LastRow As Integer
    Dim FindCol As Integer
    Dim C1 As Integer

    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    FindCol = Cells.Find(What:="DATE", LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Column

    For C1 = 2 To LastRow
            Cells(C1, FindCol).NumberFormat = "DDMMYYYY"
    Next C1

End Sub

这适用于包含日期的第一列，但不会移动到下一列。

谢谢您的帮助

问候，
亚当

Answer 1

如您所知，您需要使用 DATE 循环查找每个行标题。
这是一种方法。

Sub Dateformat()

    Dim wks As Worksheet
    Dim LastRow As Integer
    Dim FindCol As Range
    Dim sAdd As String

    Set wks = ThisWorkbook.Sheets("Sheet1") ' adjust as needed
    
    With wks
    
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        'find first instance where DATE exists in row 1 (headers)
        Set FindCol = .Rows(1).Find(What:="DATE", LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False, SearchFormat:=False)
                    
        'store address of first found instance (to check in loop)
        sAdd = FindCol.Address
        
        Do
        
            'format column (row 2 to last used row)
            .Range(.Cells(2, FindCol.Column), .Cells(LastRow, FindCol.Column)).NumberFormat = "DDMMYYYY"
            'this line works as well and is a bit cleaner
            '.Cells(2, FindCol.Column).Resize(LastRow - 1, 1).NumberFormat = "DDMMYYYY"                

            'find next instance (begin search after current instance found)
            Set FindCol = .Cells.FindNext(After:=FindCol)
            
        'keep going until nothing is found or the loop finds the first address again (in which case the code can stop)
        Loop Until FindCol Is Nothing Or FindCol.Address = sAdd
    
    End With
        
End Sub