Question

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

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

我完成的一种特殊格式是将日期转换为＆＃34; DDMMYYYY＆＃34; （09091986），它通常出现在09/09/1986。

在我的工作表中，共有3列包含日期，所有这些列都需要相同的格式，并且所有这些列都包含＆＃34; DATE＆＃34;在标题中。他们并不相邻。

我还必须小心不要让任何其他数据受到影响，因为我的名字和地址可能包含字符＆＃34; DATE＆＃34;。

所以，背景偏离......我试图搜索第一行，直到找到“＃34; Date＆＃34;然后格式化每个单元格直到最后一行，然后转到包含单词＆＃34; DATE＆＃34;的下一列。并重复此操作，直到所有列都带有＆＃34; DATE＆＃34;已被格式化。

我确定你有一个简单的解决方案，但我似乎无法自己找到它。

这是我的代码......

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 rFound 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

根据标题格式设置一系列列 - Excel

1 个答案: