2

作为工作职责，我被告知要在 Excel 2003 中打开一个电子表格（很快就会得到一台更新的计算机......），然后将一张工作表拆分为一个文档，其中包含多个基于一个 ID 的工作表：供应商 ID #。

工作表有一个单行高的标题。第一个 Header 列是“VendorID”。现在，这里的每一列都有数十个其他标题，它们包含方程式。我希望工作表是供应商 ID 的名称。

我想要的是得到很多这样的床单：

一张名为“00708”的工作表，“vendorId”的A列标题，其中包含：

vendid |  B   |  C   |  D   |
00708  | true | 1.07 | 4.52 |

只是一个例子。有许多不同信息的列。许多。

我的问题是，在工作中，我尝试了以下代码：

Option Explicit
Sub DistributeRows()
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
Dim LastRowCrit As Long
Dim I As Long


Set wsAll = Worksheets("Sheet1") ' change All to the name of the worksheet the existing data is on

LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row

Set wsCrit = Worksheets.Add

' column A has the criteria eg project ref
wsAll.Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
For I = 2 To LastRowCrit

    Set wsNew = Worksheets.Add
    wsNew.Name = wsCrit.Range("A2")
    wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
     CopyToRange:=wsNew.Range("A1"), Unique:=False
    wsCrit.Rows(2).Delete

Next I

Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True

End Sub

问题是这段代码运行得很好......直到我向右滚动更多并意识到许多列虽然仍然适当移动，但包含空格，其中不仅是数字，还有被分解的数字虽然 Excel 方程（从它们旁边的单元格中添加值，诸如此类）

所以基本上....没有明确的代码吗？我在网上搜索了几个小时，但我尝试过的任何代码都会给我错误，很抱歉没有记住，所以我可以告诉你。我很确定上面的代码是有效的，但它发出了重要的信息和方程式，并使它们变为空白。

我有大约 8000 行，并且知道 excel 可以执行 65,000 行之类的操作。我见过一些试图抓取角落到角落区域的代码，但我不需要。我需要一个抓取每一列和每一行的代码......查看第一个“类型”信息的第一个值（在本例中为供应商 ID），然后创建尽可能多的新工作表（在同一个文档中）它需要为每个不同的供应商 ID 创建一个。

任何帮助将非常感激。我试图尽可能地不必手动执行此操作。

4

0 回答 0