Question

我有一个Excel，其中包含逗号分隔的单个单元格中的多个日期，如下所示：

Name         Work Days  
Person 1     2,3,5  
Person 2     1,2  
Person 3     5  
Person 4     1,2,3,6,7

现在我需要仅针对工作日制作一个X标记，以便我的输出如下所示：

Name         Work Days    1    2    3    4    5    6    7
Person 1     2,3,5             X    X         X
Person 2     1,2          X    X
Person 3     5                                X
Person 4     1,2,3,6,7    X    X    X              X    X

请注意，表头中的日期不需要动态填充，因为它们已修复。我只需要将X标记放在相应的列上。提前谢谢！

Answer 1

由于您在解决方案中需要一些VBA，请在标准模块中输入此UDF：

Public Function IsIn(big As String, little As Variant) As String
    IsIn = ""
    If InStr(big, CStr(little)) > 0 Then
        IsIn = "X"
    End If
End Function

然后在 C2 中输入：

=isin($B2,C$1)

向上和向下复制这个：

注意：

您可以使用工作表公式而不是UDF（）

适用于1到7 （星期几）等值;对于1到31 （月中的几天）
这样的值不太好

Answer 2

我推荐加里的学生回答，但正如我在写我的时候，我想我无论如何都要把它丢弃。

Option Explicit

Sub TestParseData()
    Dim vReport As Variant
    vReport = ParseData(MockData)

End Sub

Function MockData() As Variant

    Dim vData As Variant
    ReDim vData(1 To 4, 1 To 2)
    vData(1, 1) = "Person 1"
    vData(2, 1) = "Person 2"
    vData(3, 1) = "Person 3"
    vData(4, 1) = "Person 4"

    vData(1, 2) = "2,3,5"
    vData(2, 2) = "1,2"
    vData(3, 2) = "5"
    vData(4, 2) = "1,2,3,6,7"

    MockData = vData



End Function

Function ParseData(ByVal vData As Variant) As Variant

    '* start of pre-conditions
    On Error Resume Next
    '* test for two dimension array like off a sheet range
    Dim vRows As Variant, vColumns As Variant
    vRows = UBound(vData, 1) - LBound(vData, 1) + 1
    vColumns = UBound(vData, 2) - LBound(vData, 2) + 1
    On Error GoTo 0
    If IsEmpty(vRows) Or IsEmpty(vColumns) Then Err.Raise vbObjectError, , "#Please supply a 2d array from a sheet range with two columns!"
    If vColumns <> 2 Then Err.Raise vbObjectError, , "#Please supply a 2d array from a sheet range with two columns!"
    '* end of pre-conditions

    ReDim dicPersonSchedule(LBound(vData, 1) To UBound(vData, 1)) As Scripting.Dictionary

    '* STEP 1 , load up all work days in each person's dictionary
    '*     and find Min and Max of workdays to define range
    Dim lPersonLoop As Long
    Dim lMax As Long: lMax = -1
    Dim lMin As Long: lMin = 2 ^ 30
    For lPersonLoop = LBound(vData, 1) To UBound(vData, 1)
        Set dicPersonSchedule(lPersonLoop) = New Scripting.Dictionary

        Dim vWorkDaysSplit As Variant
        vWorkDaysSplit = Split(vData(lPersonLoop, 2), ",")

        Dim vWorkDaysSplitLoop As Variant
        For Each vWorkDaysSplitLoop In vWorkDaysSplit
            If Not IsNumeric(vWorkDaysSplitLoop) Then Err.Raise "#Bad data, expecting commas and numbers!"

            If vWorkDaysSplitLoop < lMin Then lMin = vWorkDaysSplitLoop
            If vWorkDaysSplitLoop > lMax Then lMax = vWorkDaysSplitLoop
            dicPersonSchedule(lPersonLoop).add vWorkDaysSplitLoop, 0
        Next
    Next lPersonLoop

    '*STEP 2 - load the report
    ReDim vReturn(LBound(vData, 1) To UBound(vData, 1), lMin To lMax)

    For lPersonLoop = LBound(vData, 1) To UBound(vData, 1)
        For Each vWorkDaysSplitLoop In dicPersonSchedule(lPersonLoop).Keys
            vReturn(lPersonLoop, vWorkDaysSplitLoop) = "X"
        Next

    Next lPersonLoop

    ParseData = vReturn



End Function

将单元格值拆分为多个列

2 个答案: