在行中搜索日期并返回列字母时出错

Question

正在尝试在特定行中搜索日期。然后 return 从列号转换后的列字母。一旦列字母被 returned，就需要收集数据并将其传输到 sheet2。我目前遇到类型不匹配 13。如有任何帮助，我们将不胜感激。

Sub Color()

Dim CountColor As Long
Dim CountBlack As Long
Dim CountWhite As Long
Dim TextWhite As String
Dim TextBlack As String
Dim TextRed As String
Dim cell As Range
Dim ColumnNumber As Integer
Dim ColumnLetter As Integer

With Sheets("Sheet1")
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
End With

Dateini = 1 / 22 / 2021

ColumnNumber = ActiveSheet.Columns("B:B").Find(What:=1 / 22 / 2021, After:=ActiveCell, LookIn:=xlValues, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
    False, SearchFormat:=False).Column
    
ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)


For Each cell In Range("A1:Z1")

If cell.Interior.ColorIndex = 3 Then

    CountColor = CountColor + 1
    Sheets("Sheet2").Range("E1").Value = CountColor
    TextRed = cell.Offset(0, -Abs(ColumnNumber - 1))
    Sheets("Sheet2").Range("F" & CountColor).Value = TextRed
    
ElseIf cell.Interior.ColorIndex = 1 Then

    CountBlack = CountBlack + 1
    Sheets("Sheet2").Range("E2").Value = CountBlack
    TextBlack = cell.Offset(0, -Abs(ColumnNumber - 1))
    Sheets("Sheet2").Range("G" & CountBlack).Value = TextBlack
    
ElseIf cell.Interior.ColorIndex = xlNone Then

    CountWhite = CountWhite + 1
    Sheets("Sheet2").Range("E3").Value = CountWhite
    TextWhite = cell.Offset(0, -Abs(ColumnNumber - 1))
    Sheets("Sheet2").Range("J" & CountWhite).Value = TextWhite

End If
Next cell

End Sub

Answer 1

如果您将 Option Explicit 添加到代码的顶部，编译器会告诉您 LastRow 和 Dateini 未定义。
Dateini = 1 / 22 / 2021 分配一个数值 2.24911160091764E-05 作为日期是 1899-12-30。使用 Dateini = Format("2021-01-22","yyyy-mm-dd") 并且日期是明确的。
Dim ColumnLetter As Integer 应该是 As String
ColumnNumber = .Find(...).Column 将抛出错误。将 .Find() 分配给一个范围，然后在分配 ColumnNumber = rng.Column

NOT nothing

Find(What:=1 / 22 / 2021, After:=ActiveCell应该是Find(What:=Dateini,，如果Active cell不在搜索范围内就会报错
你需要解释这一行的作用 cell.Offset(0,-Abs(ColumnNumber - 1)) 因为它看起来与 - 符号和 Abs().
另请注意 Color 是某些对象的属性，因此不是宏名称的好选择。使用类似 ColorMacro.

Option Explicit

Sub ColorMacro()

    Dim CountWhite As Long, CountBlack As Long, CountColor As Long
    Dim ColumnNumber As Integer
    Dim ColumnLetter As String ' was Integer
    
    Dim Dateini As Date
    Dateini = DateValue("2021-01-01") '  1 / 22 / 2021
    
    Dim rngFound As Range, cell As Range
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Set wb = ActiveWorkbook ' or Thisworkbook
    Set ws1 = wb.Sheets("Sheet1")
    Set ws2 = wb.Sheets("Sheet2")

    Set rngFound = ws1.Rows(1).Find(What:=Dateini, LookIn:=xlValues, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
        False, SearchFormat:=False)
        
    ' check if date found
    If rngFound Is Nothing Then
        MsgBox "Could not find " & Format(Dateini, "yyyy-mm-dd"), vbCritical
        Exit Sub
    Else
        Debug.Print Format(Dateini, "yyyy-mm-dd") _
        & " found in " & rngFound.Address(1, 1, xlA1, True)
    End If

    ColumnNumber = rngFound.Column
    ColumnLetter = Split(rngFound.Address, "$")(1)
    
    For Each cell In ws1.Range("A1:Z1")
    
        If cell.Interior.ColorIndex = 3 Then       
            CountColor = CountColor + 1
            ws2.Range("F" & CountColor).Value = cell.Offset(0, Abs(ColumnNumber - 1))         
        ElseIf cell.Interior.ColorIndex = 1 Then
            CountBlack = CountBlack + 1
            ws2.Range("G" & CountBlack).Value = cell.Offset(0, Abs(ColumnNumber - 1))    
        ElseIf cell.Interior.ColorIndex = xlNone Then
            CountWhite = CountWhite + 1
            ws2.Range("J" & CountWhite).Value = cell.Offset(0, Abs(ColumnNumber - 1))
        End If

    Next cell

    ' counts
    With ws2
        .Range("F:F,G:G,J:J").NumberFormat = "m/d/yyyy"
        .Range("E1").Value = CountColor
        .Range("E2").Value = CountBlack
        .Range("E3").Value = CountWhite
    End With
    MsgBox "Finished"
End Sub

在行中搜索日期并返回列字母时出错

Error Searching Row for Date and returning column letter

excel

vba

type-mismatch