Question

我有一张包含数百个价格网格的工作簿，需要将这些工作簿拆分为单独的工作簿（每个工作簿一个价格网格）。这里所需的VBA水平在很大程度上超过了我对这个主题的基本知识，我非常感谢你愿意给予的任何帮助。

每个工作表都有许多不同大小的网格，由空行和空白列分隔：

+----------+------+------+------+------+------+
| Product1 |      |  100 |  200 | 300  |  400 |
| Product2 |  600 |  862 |  976 | 1024 | 1456 |
| Product3 |  800 |  975 | 1076 | 1156 | 1287 |
| Product4 | 1000 | 1076 | 1187 | 1245 | 1867 |
|          | 1200 | 1187 | 1294 | 1354 |      |
+----------+------+------+------+------+------+

我需要为每个产品制作一个Excel文件/工作簿。每个工作簿的名称将是A列中的产品名称，内容必须是没有A列的完整网格，因此只有所有数字。每个工作簿都可以保存在ActiveWorkbook.Path中。给出的示例将生成4个名为Product1，Product2，Product3和Product4的文件。每个文件只包含从单元格A1开始的定价网格，如示例中所示有时为空。

以下代码选择工作表上的每个价格网格块，但后来我不确定如何循环数据以提取产品名称。此示例中的“Sheet1”和“A1”也需要是动态值，这将循环遍历所有工作表并查找每个工作表上的所有块。

Sub DynamicRange()

Dim sht As Worksheet
Dim StartCell As Range

Set sht = Worksheets("Sheet1")
Set StartCell = Range("A1")

StartCell.CurrentRegion.Select

End Sub

请帮帮忙？

Answer 1

解决方案取决于数据的分离方式。你的例子不清楚。

您说数据由一个空行和一个空白列分隔。这是什么？

您还说您希望将工作簿命名为Product1，Product2等，但在您的示例中，最后一行为空。工作簿不能有空白名称。

这是一些循环工作表并输出工作簿的代码，假设您可以选择范围。

Option Explicit

Sub loopThroughSheets()
    Dim ws  As Worksheet
    Dim rng As Range

    For Each ws In ActiveWorkbook.Sheets
        ' ... some loop to select ranges here ...
            Call outputRange(rng)
    Next ws

End Sub

Sub outputRange(rng As Range)
    Dim wb      As Workbook
    Dim arry()  As Variant
    Dim i       As Integer
    Dim j       As Integer
    Dim wbName  As String
    arry = rng'assigns range values to variant array

    Application.DisplayAlerts = False
    For i = 1 To UBound(arry, 1)
        Set wb = Workbooks.Add
        wbName = arry(i, 1)
        For j = 2 To UBound(arry, 2)
            wb.Sheets(1).Cells(1, j - 1) = arry(i, j)
        Next j
        Wk.SaveAs Filename:=(ActiveWorkbook.Path & "\" & wb.name & ".xlsx")
    Next i

    Application.DisplayAlerts = True
End Sub

Answer 2

谢谢Daniel ......我让它运转了。

// Create a new asset var new_asset = document.createElement('video'); new_asset.setAttribute('id', 'dynVid'); // Create a unique id for asset new_asset.setAttribute('src', videoUrl); // Append the new video to the a-assets, where a-assets id="assets-id" document.getElementById('assets-id').appendChild(new_asset); // Add the asset to the a-video screen.setAttribute('src', '#dynVid'); // Start playback new_asset.play();


Sub ExtractGridsMS()

Dim wbAllProducts As Workbook
Dim wsAllProducts As Worksheet

Set wbAllProducts = ThisWorkbook

For Each wsAllProducts In wbAllProducts.Sheets
    MkDir wbAllProducts.Path & "\" & wsAllProducts.Name
    For Each it In wsAllProducts.Columns(1).SpecialCells(2)
    With Workbooks.Add
        it.CurrentRegion.Offset(, 1).Copy .Sheets(1).Cells(1)
        .SaveAs wbAllProducts.Path & Application.PathSeparator & wsAllProducts.Name & Application.PathSeparator & it.Value & ".xls", xlExcel8
        .Close 0
    End With
    Next it
ChDir ".\.."
Next wsAllProducts

使用动态自动调整VBA范围从工作表创建工作簿

2 个答案: