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")&"/"

将日期名称转换为系列

3 个答案: