这感觉就像它应该是相对简单的，如果我访问一个明智的编程语言，如Python或P“”，但内置的Excel函数是不适用的，正如将要解释的，我对我的知识边缘运行。

输入数据：

下面是一个数据的示例，以说明我正在处理的内容：

我用 * 斜体字加了一些注解。
我的第一个想法是“unpivot”，但由于所有的列标题都是动态生成的，我不能把它变成一个表，因此不允许使用unpivot。
我认为很多存储数据列是多余的，所以我会询问同事如何消除多余的数据列，但这是目前的情况。

目标：

这个数据（上面屏幕截图中的主要红色区域）需要“扁平化”为每个值一行，这是另一个团队输入数据库所需的格式。这个屏幕截图是工作表当前输出的一个例子，颜色与第一个图像匹配：

也就是说，每一个商店，每一个日期都有一行。或者，2D数组中的每个值都从左到右，从上到下读取，并垂直写入，包括一些存储细节和列标题。
正如您所看到的，有些列标题有不同的名称，我将最有可能只是重命名源数据中不一致的标题。此外，还有几个额外的列，我可以根据其他使用公式生成。他们的顺序并不重要。
令人烦恼的是，新的存储有时会打开，因此表可以垂直地变高，因此解决方案需要能够进行调整以封装新的存储。

我的想法至今

严格地说，由于大多数数据的动态特性，所需的输出可以覆盖主要数据值，并仅填充CC代码和日期的列：
| 代码|日期|值|
| --|--|--|
| 1 |23年1月1日|值1|
| ……|……|……|
.然后可以根据上述数据计算其他列。
如果对您的解决方案有帮助，我可以根据需要重新排列存储数据列和标题行。
不幸的是，在公司最终升级之前，我也只能使用Excel 2016-但是我需要在下一个冰河时代之前完成这项工作，所以我不能使用Excel 2019或更高版本中引入的任何内容。无溢出、LET()等。

宏/伪代码

我倾向于一个按钮点击激活的宏是这里的解决方案，我试图写我自己的，但我没有足够的知识来正确地做。我有其他语言的编程经验，所以我在下面概述了我如何想象我会这样做的伪代码。
我相信，与其试图使用聪明的技巧来选择一系列数据，代码应该尽可能简单，明确，并且简单易懂，尽可能依赖Excel的常规函数来确定变量值，例如。对于非程序员来说，通过几个单元格值比通过修改“0”更容易定义要工作的范围。这将使它更容易维护的人甚至比我更少的编程经验。例如，当添加新数据时，内置函数应自动调整其选择的大小，因此在这些计算单元上绘制的代码将自动适应变化。这些数据都可以存储在一些“控制面板”工作表中的命名单元格中，这些单元格也可以容纳用于激活宏的按钮。

Sub makeOutput()
  Dim srcSheet as Worksheet
  Dim ctrlSheet as Worksheet
  Dim outputSheet as Worksheet 'importantly the sheet already exists and probably already contains some data, more on this later. 
  Dim i As Long, j As Long
  Dim dataHeight As Long, dataWidth As Long 'size of the block of values (red in the screenshot)
  Dim dataStart ' top left cell of the data range
  Dim outputArr()
  Dim ccRange As Range 'The range containing the CC numbers 
Dim dateRange as Range 'Range of date values 

  Set srcSheet = Sheets("Daily Sales Forecast") 'I'll either make this an argument to the function or just copy-paste the whole subroutine for each sheet that follows this pattern and change the name here. 
  Set outputSheet = Sheets("Daily Sales Output") ' as above, could be an argument so I can recycle this subroutine
  Set ctrlSheet = Sheets("Control Panel")
  With ctrlSheet
    dataHeight = .Range("Data_Height").Value ' from named cell
    dataWidth = .Range("Data_Height").Value ' from named cell
    dataStart = .Cells(.Range("Start_Col").Value, .Range("Start_Row").Value)  ' from named cells that use =CELL("row",data:range) and =CELL("col", data:range) so if anything moves the data range, it'll automatically update these selectors. 
  End With
  
  ReDim Preserve outputArr(3,srcDataRange.Count) 'make the intermediary output array sized 3 wide (for CC, Date, Value columns), and the height of all the value cells.

  With srcSheet ' this is where I'm starting to struggle:
    Set srcDataRange = dataStart.Resize(dataHeight, dataWidth) ' does this work..? 
    Set ccRange = .Range(" EXPLICIT_RANGE_REFERENCE_HERE") ' the CC column is probably not going to move, so I'm ok hardcoding it. It's B4:B7 in the example screenshot
    Set
  End With

  ' Now we're entering "very unsure" territory:
 
  ' Lets construct our output array: 
  Dim counter As Integer ' Keeps track of which cell in the srcData we're at
  counter = 0
  For i = 1 To dataWidth  ' iter cols (x-axis, in my mind)
    For j = 1 To dataHeight ' iter rows (y-axis)
      counter = counter + 1
      ' first column of output can be the value:
      outputArr(counter, 1) = srcDataRange.Cells(i, j) ' not sure if i and j are the right way around...
      ' col 2 can be the CC code:
      outputArr(counter, 2) = ccRange.Cells(1, i) ' I don't know if indexes are relative to range origin or sheet origin, if the latter then `1` is incorrect here and would need padding out or calculated to be the column index of CC column. Could do that anyway and avoid needing to define "ccRange" at all, but we're being explicit/idiot-proof here so I prefer a variable. 
      ' col 3 can be the date:
      outputArr(counter, 3) = 
    Next
  Next
  
  ' This is where I have truly run out of steam, I now need to paste `outputArr` into `outputSheet`'s first 3 columns, starting from row 2, such that column headers don't get overwritten. I also need to not overwrite anything in the fourth column and beyond (D+) as I'll have put some more functions in these columns by hand. 
End Sub

编辑：根据要求，我设想的控制面板伴随着我的伪代码（范围基于示例截图）：
| 数据宽度|数据_高度|开始栏|开始_行|
| --|--|--|--|
| =COLUMNS（'每日销售预测'！G4：L8）|=ROWS（“每日销售预测”！G4：L8）-1| =CELL（“col”，'每日销售预测'！G4：L8）|=CELL（“row”，'每日销售预测'！G4：L8）|
Data_Height单元格上的-1用于抵消区域G4:L8底部包含空白行的事实，这允许在数据集底部插入新行/存储时自动扩展区域。（最大限度地减少忙碌的财务人员今后需要做的工作）。对于CELL函数来说，范围选择是长是短都没有关系，因为我们只是获取左上角的单元格。
如果我可以澄清任何其他请做评论，并感谢您的任何帮助。

试试看吧

Option Explicit
Sub Demo()
    Dim i As Long, j As Long
    Dim idx As Long, k As Long
    Dim arrData, arrRes(), newCol
    Dim srcSht As Worksheet
    Dim lastRow As Long, lastCol As Long
    Const FIXED_COL_COUNT = 4 ' First 4 cols are fixed
    Const COL_COUNT = 8 ' 8 columns in output table
    Const HEADER_ROW = 3 ' Header row# in source table
    ' Extra new column name
    newCol = Array("Date", "wc", "WK No", "Value")
    Set srcSht = Sheets("Sheet2") ' source sheet, update as needed    
    With srcSht
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        ' load data
        arrData = .Range("A1", .Cells(lastRow, lastCol))
    End With
    idx = 1
    ReDim Preserve arrRes(1 To COL_COUNT, 1 To idx)
    ' Output table header
    For k = 1 To COL_COUNT
        If k > FIXED_COL_COUNT Then
            arrRes(k, idx) = newCol(k - FIXED_COL_COUNT - 1)
        Else
            arrRes(k, idx) = arrData(HEADER_ROW, k)
        End If
    Next
    ' Extract data
    For i = HEADER_ROW + 1 To UBound(arrData)
        For j = FIXED_COL_COUNT + 1 To UBound(arrData, 2)
            idx = idx + 1
            ReDim Preserve arrRes(1 To COL_COUNT, 1 To idx)
            For k = 1 To FIXED_COL_COUNT
                arrRes(k, idx) = arrData(i, k)
            Next
            arrRes(FIXED_COL_COUNT + 1, idx) = arrData(2, j)
            arrRes(FIXED_COL_COUNT + 3, idx) = arrData(1, j)
            arrRes(FIXED_COL_COUNT + 4, idx) = arrData(i, j)
        Next j
    Next i
    ' Add new sheet to store output
    Sheets.Add
    With ActiveSheet
        .Range("A1").Resize(UBound(arrRes, 2), UBound(arrRes)).Value = Application.Transpose(arrRes)
    End With
End Sub

更新：
要求来自修订后的OP和评论。

注 *：Data_Width的公式应该是=COLUMNS('Daily Sales Forecast'!G4:L8)（如果我是正确的，请更新OP）。

只要可行，代码就会紧密地遵循伪代码流。

Option Explicit

Sub makeOutput()
    Dim srcSheet As Worksheet
    Dim ctrlSheet As Worksheet
    Dim outputSheet As Worksheet 'importantly the sheet already exists and probably already contains some data, more on this later.
    Dim c As Long, r As Long
    Dim startRow As Long, startCol As Long
    Dim dataHeight As Long, dataWidth As Long 'size of the block of values (red in the screenshot)
    Dim dataStart As Range ' top left cell of the data range
    Dim outputArr()
    Dim ccRange As Range 'The range containing the CC numbers
    Dim dateRange As Range 'Range of date values
    Dim srcDataRange As Range
    
    Set srcSheet = Sheets("Daily Sales Forecast") 'c'll either make this an argument to the function or just copy-paste the whole subroutine for each sheet that follows this pattern and change the name here.
    Set outputSheet = Sheets("Daily Sales Output") ' as above, could be an argument so c can recycle this subroutine
    Set ctrlSheet = Sheets("Control Panel")
    
    With ctrlSheet
        dataHeight = .Range("Data_Height").Value ' from named cell
        dataWidth = .Range("Data_Width").Value ' from named cell
        startRow = .Range("Start_Row").Value
        startCol = .Range("Start_Col").Value
        Set dataStart = srcSheet.Cells(startRow, startCol) ' get the top-left cell ref
    End With

    With srcSheet
        Set srcDataRange = dataStart.Resize(dataHeight, dataWidth) ' does this work..?
        Set ccRange = .Cells(startRow, "B").Resize(dataHeight, 1) ' hardcode is not recommanded
    End With
    
    ReDim outputArr(1 To srcDataRange.Cells.Count, 1 To 3) 'make the intermediary output array sized 3 wide (for CC, Date, Value columns), and the height of all the value cells.
    
    ' Lets construct our output array:
    Dim counter As Long ' Keeps track of which cell in the srcData we're at
    counter = 0
    For r = 1 To dataHeight ' iter rows (y-axis)
        For c = 1 To dataWidth  ' iter cols (x-axis, in my mind)
            counter = counter + 1
            ' first column of output can be the value:
            outputArr(counter, 1) = srcDataRange.Cells(r, c)   ' not sure if c and r are the right way around...
            ' col 2 can be the CC code:
            outputArr(counter, 2) = ccRange.Cells(r)
            ' col 3 can be the date:
            outputArr(counter, 3) = srcSheet.Cells(2, startCol - 1 + c)
        Next
    Next
    ' paste `outputArr` into `outputSheet`'s first 3 columns, starting from row 2
    With outputSheet
        .Range("A2").Resize(counter, 3).Value = outputArr
    End With
End Sub

excel 展平2D数组/数据“表格”，不使用反透视

输入数据：

目标：

我的想法至今

宏/伪代码

1条答案

相关问题

热门标签

最新问答