☰

单元格模式值到列

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 microsoft-excel-2016
单元格模式值到列

有什么方法可以将下面的模式转换成列吗？

附上图像以供参考，以便更好地理解输入模式是什么以及需要输出什么。

模式值到列

另一张照片

在此处输入图片描述

编辑：我添加了另一个屏幕截图

在此处输入图片描述

谢谢您的支持。

答案1

您在所需输出中显示的格式阻止使用 Power Query（结果比我想象的要复杂）。

但是这里有一个 VBA 例程，它将根据您的输入生成您所显示的内容。

要输入此宏（子），alt-F11请打开 Visual Basic 编辑器。确保您的项目在 Project Explorer 窗口中突出显示。然后，从顶部菜单中，选择Insert/Module下面的代码并将其粘贴到打开的窗口中。

要使用此宏（子），alt-F8请打开宏对话框。按名称选择宏，然后RUN。

宏假设您的表格（如屏幕截图所示）

  • 从 A1 开始
  • 第 1 行的列标题
  • 从 A2 开始，在 A 列中连续编号
  • 图案从 B2 开始

宏中的注释以及代码应该可以解释所使用的算法。但如果有任何不清楚的地方，请询问。

Option Explicit
Sub patternToColumns()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim I As Long, J As Long, K As Long, S As String, v As Variant
    Dim arrList As Object, x(1) As Variant
    Dim col As Collection
    
'read the source data into VBA array
Set wsSrc = ThisWorkbook.Worksheets("Sheet1")
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2)
End With

'set results destination
Set wsRes = ThisWorkbook.Worksheets("sheet1")
    Set rRes = wsRes.Cells(1, 4) 'D1

Set arrList = CreateObject("System.Collections.ArrayList")
Set col = New Collection

'split string on change in character
'store each pair of character/count as an array within an ArrayList
For I = 2 To UBound(vSrc)
    arrList.Clear
    S = vSrc(I, 2)
    
    x(0) = Mid(S, 1, 1)
    x(1) = 1
    
    For J = 2 To Len(S)
        Select Case J
            Case Is < Len(S)
                If Mid(S, J, 1) = x(0) Then
                    x(1) = x(1) + 1
                Else
                    arrList.Add x
                    x(0) = Mid(S, J, 1)
                    x(1) = 1
                End If
            Case Is = Len(S)
                If Right(S, 1) = x(0) Then
                    x(1) = x(1) + 1
                    arrList.Add x
                Else
                    arrList.Add x
                    x(0) = Right(S, 1)
                    x(1) = 1
                    arrList.Add x
                End If
        End Select
    Next J
    
    'each completed array list represents one row of pattern
    '   and 2 columns of output
    'each collection item = 1 column pair of output
    col.Add Item:=arrList.toarray, Key:=CStr(I)
Next I

'dim results array
I = 0
For Each v In col
    I = IIf(I > UBound(v), I, UBound(v))
Next v

ReDim vRes(0 To I + 1, 1 To col.Count * 2)

'Populate the array

'headers
For J = 1 To UBound(vRes, 2) Step 2
    vRes(0, J) = J / 2 + 0.5
Next J

J = -1

For Each v In col
    J = J + 2
    I = 0
    For K = 0 To UBound(v)
        I = I + 1
        vRes(I, J) = v(K)(0)
        vRes(I, J + 1) = v(K)(1)
    Next K
Next v


'write to worksheet and format
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
    .CurrentRegion.Clear
    .EntireColumn.Clear
    .Value = vRes
    
    .Replace "d", "day"
    .Replace "n", "night"
    .Replace "x", "off"
    
    With .Rows(1)
        For J = 1 To .Cells.Count Step 2
            Range(.Cells(J), .Cells(J + 1)).HorizontalAlignment = xlCenterAcrossSelection
        Next J
    End With
    .EntireColumn.AutoFit
    .Style = "Output" 'may need to be more specific with non-English Excel
    
    Dim C As Range
    For Each C In rRes
        With C
            If .Value = "off" Then
                .Font.Color = RGB(165, 165, 165)
                .Offset(0, 1).Font.Color = RGB(165, 165, 165)
            End If
        End With
    Next C
End With
    
End Sub

在此处输入图片描述

答案2

我确信有更优雅（比如说更简单）的解决方案，但下面的方法有效。它需要一个表来查找字符串中每个字母的输出内容（因此，如果找到“d”，则返回“day”等等），输出的第一列的公式期望在 A1:B3 中。除了有点蛮力之外，有一件事我没有找到纠正的方法，那就是输出表的Spill功能输出在其底部都有一个“多余的”空白单元格……但它们确实有效，因此：

  1. 首先，第一列的公式：
=TRANSPOSE(XLOOKUP(MID(D1,UNIQUE(IF(MID(D1,SEQUENCE(1,LEN(D1),1,1),1)=MID(D1,SEQUENCE(1,LEN(D1),2,1),1),1,SEQUENCE(1,LEN(D1),2,1)),TRUE),1),A1:A3,B1:B3,"",0))

进而

  1. 第二列的公式：
=IFERROR(TRANSPOSE(INDEX(UNIQUE(IF(MID(D1,SEQUENCE(1,LEN(D1),1,1),1)=MID(D1,SEQUENCE(1,LEN(D1),2,1),1),1,SEQUENCE(1,LEN(D1),2,1)),TRUE),,SEQUENCE(1,COUNT(UNIQUE(IF(MID(D1,SEQUENCE(1,LEN(D1),1,1),1)=MID(D1,SEQUENCE(1,LEN(D1),2,1),1),1,SEQUENCE(1,LEN(D1),2,1)),TRUE)),2,1))-INDEX(UNIQUE(IF(MID(D1,SEQUENCE(1,LEN(D1),1,1),1)=MID(D1,SEQUENCE(1,LEN(D1),2,1),1),1,SEQUENCE(1,LEN(D1),2,1)),TRUE),,SEQUENCE(1,COUNT(UNIQUE(IF(MID(D1,SEQUENCE(1,LEN(D1),1,1),1)=MID(D1,SEQUENCE(1,LEN(D1),2,1),1),1,SEQUENCE(1,LEN(D1),2,1)),TRUE)),1,1))),"")

并做了。

我确信，如果没有其他办法，TRANSPOSE()可以通过更巧妙地使用来取消这些功能SEQUENCE()，但我没有时间了。

第二个技巧的关键是使用SEQUENCE()从 2 开始减去SEQUENCE()从 1 开始的方法，然后做类似的事情，INDEX()使用位置来判断输出表中每个位置要报告多少个字母。

最后，两列公式的结果完全独立于彼此。因此，改进其中之一的编辑不会破坏另一个。第二个实际上只是一些构建块元素，并不复杂。只是看起来令人讨厌。

相关内容