Question

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

工作表有一行高标题。第一个标题列是“VendorID”。现在，这里每列有其他标题的DOZENS，它们包含方程式。我希望工作表是供应商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创建一个。

非常感谢任何帮助。我试图尽可能不用手工做。

Excel VBA：从共享列值创建新表

0 个答案: