将日期名称转换为系列

Question

我正在寻找将日期转换为特定系列的代码。 例如。

If it is Monday I want - N/Y/N/N/N/N/N
If it is Wednesday I want - N/N/N/Y/N/N/N
if it is Sunday, Friday I want - Y/N/N/N/N/Y/N

有什么方法可以在 VBA 或 excel 中做到这一点。

提前致谢。

Answer 1

这使用数组来创建你想要的模式。

Sub trnsfrm()
Dim rang As Range
Set rang = Worksheets("Sheet4").Range("A1:A3") ' Change to your range and worksheet

Dim rng() As Variant
rng = rang.Value

Dim WeekDy As Variant
WeekDy = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")

Dim outArr(1 To 7) As Variant

Dim j As Long
For j = LBound(rng) To UBound(rng)
    Dim i As Long
    For i = LBound(WeekDy) To UBound(WeekDy)
        If InStr(rng(j, 1), WeekDy(i)) > 0 Then
            outArr(i + 1) = "Y"
        Else
            outArr(i + 1) = "N"
        End If
    Next i
    rng(j, 1) = Join(outArr, "/")
Next j

rang.Value = rng


End Sub

转弯：

进入：

Answer 2

我的想法与 Scott 的方法非常相似，但我找到了一种更短的方法来做到这一点。将代码放在模块中，您可以在工作表中作为函数访问它：

Function TagDays(rng As Range)
    strDays = "SUNDAY1MONDAY2TUESDAY3WEDNESDAY4THURSDAY5FRIDAY6SATURDAY7)"
    arr = Array("N", "N", "N", "N", "N", "N", "N")
    For Each cell In rng
        If cell <> "" Then
            i = InStr(strDays, UCase(cell))
            If i > 0 Then arr(Mid(strDays, i + Len(cell), 1) - 1) = "Y" '-1 since the LBOUND of arr is 0 not 1
        End If
    Next cell
    TagDays = Join(arr, "/")
End Function

调用函数并选择您想要的范围，它可以是多列，即使您添加或删除天数，结果也应该在现场更新。它也不区分大小写。此外，它会忽略空白单元格。

输出：

编辑：下面的代码也可以处理一个单元格中用逗号分隔的日期，空格无关紧要

Function TagDays(rng As Range)
    strDays = "SUNDAY1MONDAY2TUESDAY3WEDNESDAY4THURSDAY5FRIDAY6SATURDAY7)"
    arr = Array("N", "N", "N", "N", "N", "N", "N")
    For Each cell In rng
        If cell <> "" Then
            arr2 = Split(cell.Value, ",")
            For j = LBound(arr2) To UBound(arr2)
                strday = Trim(UCase(arr2(j)))
                i = InStr(strDays, strday)
                If i > 0 Then arr(Mid(strDays, i + Len(strday), 1) - 1) = "Y" '-1 since the LBOUND of arr is 0 not
            Next j
        End If
    Next cell
    TagDays = Join(arr, "/")
End Function

输出：

将函数单独应用于单元格（如 Scott 的示例）将为您提供：

Answer 3

您实际上并不需要 VBA 来执行此操作。只需使用此公式（假设它是 A 列）。提醒alt enter 可让您输入公式以提高可读性。

=IF(ISERROR(MATCH("Sunday",A:A,0)),"N","Y")&"/"&
 IF(ISERROR(MATCH("Monday",A:A,0)),"N","Y")&"/"&
 IF(ISERROR(MATCH("Tuesday",A:A,0)),"N","Y")&"/"&
 IF(ISERROR(MATCH("Wednesday",A:A,0)),"N","Y")&"/"&
 IF(ISERROR(MATCH("Thursday",A:A,0)),"N","Y")&"/"&
 IF(ISERROR(MATCH("Friday",A:A,0)),"N","Y")&"/"&
 IF(ISERROR(MATCH("Saturday",A:A,0)),"N","Y")

如果您必须在“星期一，星期二”等单元格中进行搜索，则可以使用此公式。 这是一个数组公式，您必须按 CTL SHFT ENTER 才能起作用。

=IF(OR(NOT(ISERROR(FIND("Sunday",A:A,1)))),"Y","N")&"/"&
IF(OR(NOT(ISERROR(FIND("Monday",A:A,1)))),"Y","N")&"/"&
IF(OR(NOT(ISERROR(FIND("Tuesday",A:A,1)))),"Y","N")&"/"&
IF(OR(NOT(ISERROR(FIND("Wednesday",A:A,1)))),"Y","N")&"/"&
IF(OR(NOT(ISERROR(FIND("Thursday",A:A,1)))),"Y","N")&"/"&
IF(OR(NOT(ISERROR(FIND("Friday",A:A,1)))),"Y","N")&"/"&
IF(OR(NOT(ISERROR(FIND("Saturday",A:A,1)))),"Y","N")&"/"