将数据移动到新选项卡并重新格式化以使其更易于导出到访问答案

【问题标题】：Moving Data to new tab and reformatting it to make it easier to Export To Access将数据移动到新选项卡并重新格式化以使其更易于导出到访问
【发布时间】：2022-06-12 00:49:58
【问题描述】：

我们目前有一个用于计划的电子表格，使用它的绅士不想改变它，所以我想的是使用 VBA 或宏创建一个具有不同格式的新工作表，还是？然后，我将能够将新工作表导入到不同程序所需的访问权限中。我附上了两张不同的图片，第一张是现在的样子，第二张是我想要的样子。

旧格式

新格式

。我没有在 Excel 中进行大量编码，通常只是 ='Sheet1'!E5，但没有看到如何正确移动日期，然后在其他任何地方都不显示日期。日程安排可能为一天分配一个项目或多个项目。如果我遗漏了一些有用的东西，请告诉我。

【问题讨论】：

我只在Access中熟悉VBA。

标签： excel vba

【解决方案1】：

如果我理解正确的话... 旧格式是这样的：

新格式的预期结果：

如果这就是你的意思......

Sub test()
Dim rg As Range: Dim cell As Range
Dim rgCnt As Range: Dim cnt As Long

Sheets("Sheet1").Copy Before:=Sheets(1)

With ActiveSheet
    .Name = "TEST"
    .Columns(1).Insert
    .Range("A1").Value = "DATE"
    Set rg = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
End With

For Each cell In rg.SpecialCells(xlCellTypeBlanks)
    Set rgCnt = Range(cell.Offset(1, 0), cell.Offset(1, 0).End(xlDown))
    If cell.Offset(2, 0).Value = "" Then cnt = 1 Else cnt = rgCnt.Rows.Count
    cell.Offset(1, -2).Resize(cnt, 1).Value = cell.Offset(0, 1).Value
Next

rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

在旧格式中有一个一致的模式，其中 B 列中每个空白单元格的右侧是日期。所以我们以B列的空白单元格为基准，得到C列的日期。

过程：
它在旧格式所在的位置复制 sheet1。
将复制的工作表命名为“TEST”
插入一列，并输入标题名称“DATE”
因为 HD-2 现在位于 C 列（插入一列之后）
因此代码为 C 列中的数据范围创建了一个 rg 变量。

然后它只循环到 rg 中的空白单元格
设置范围以检查每个日期下有多少数据到 rgCnt
如果循环单元格偏移量（2,0）为空白，则日期下只有一个数据，则值为 cnt = 1
如果循环单元格 offset(2,0) 不是空白，则日期下有多个数据，则从 rgCnt 行数中获取 cnt 的值。然后它用 cnt 值定义的行数填充 A 列（DATE 标题）。

循环完成后，它会删除rg变量中的所有空白单元格行。

【讨论】：