VBA 数组操作

发布于 2024-12-20 09:11:03 字数 2441 浏览 2 评论 0原文

我发现了一个宏（由 Jerry Beaucaire 提供），它可以根据给定列中的唯一值将一个工作表分成多个工作表。这很好用。然而......

客户提供了一个不同格式的工作表，需要一些温和的调整才能进入我们需要的格式。

首先，让我向您展示 JB 的代码片段：

MyArr = Application.WorksheetFunction.Transpose _
    (ws.Columns(iCol).SpecialCells(xlCellTypeConstants))

据我所知（我是一个 VB 新手，所以我知道什么..？？），这会用选定的行值填充一个数组

：

For Itm = 2 To UBound(MyArr)

    ...(code removed)

    ws.Range("A" & TitleRow & ":A" & LR).EntireRow.Copy _
        Sheets(MyArr(Itm) & "").Range("A1")


    ...(code removed)

Next Itm

……好像是在复制。

好吧。 ...到目前为止还好。

问题是我需要在该过程中添加一个步骤。这很难解释。请耐心等待...

标题行是第 1 行

数据从第 2 行开始

每行有 9 列：

colA：标识符

colB-colD：x、y、z 值（用于项目顶部）

colE-colG：x、y、 z 值（用于项目底部）

colH 和 colI：可以忽略

这些 x、y 和 z 值用于定义用于在 3D 建模程序中绘制线条的点。工作表中的每一行实际上定义了一条线（嗯......起点和终点 - “顶部”和“底部”）不幸的是，我们收到的数据（工作表）为每条线定义了两组数据 - 两者具有相同的起点，但具有不同的终点。换句话说，从第 3 行和第 4 行开始，两行的 BD 列中的数据是相同的。这适用于第 5 行和第 5 行。 6、7 和8 等。

由于我们需要的只是一组数据 POINTS，因此我们可以安全地使用 cols EG 中的值。
但是...这就是我需要帮助的地方...我们需要新创建的工作表的第一行以第 2 行 BD 列的值开始。（即，我们可以使用终点作为坐标，但我们仍然需要第一个起点）其余的都可以。

例如：

源数据：

   | A  |   B   |   C   |   D   |     E    |     F    |     G    |
 1 | id | x-top | y-top | z-top | x-bottom | y-bottom | z-bottom |
 2 | H1 | 101.2 | 0.525 | 54.25 |  110.25  |  0.625   |  56.75   |
 3 | H1 | 110.25| 0.625 | 56.75 |  121.35  |  2.125   |  62.65   |
 4 | H1 | 110.25| 0.625 | 56.75 |  134.85  |  3.725   |  64.125  |  B,C,D same as row 3
 5 | H1 | 134.85| 3.725 | 64.125|  141.25  |  4.225   |  66.75   |
 6 | H1 | 134.85| 3.725 | 64.125|  148.85  |  5.355   |  69.85   |  B,C,D same as row 5

我需要什么：

   | A  |   B   |   C   |   D   |     E    |     F    |     G    |
 1 | id | x-top | y-top | z-top | x-bottom | y-bottom | z-bottom |
 2 | H1 |       |       |       |  101.2   |  0.525   |  54.25   |
 3 | H1 | 101.2 | 0.525 | 54.25 |  110.25  |  0.625   |  56.75   |
 4 | H1 | 110.25| 0.625 | 56.75 |  121.35  |  2.125   |  62.65   |
 5 | H1 | 110.25| 0.625 | 56.75 |  134.85  |  3.725   |  64.125  |
 6 | H1 | 134.85| 3.725 | 64.125|  141.25  |  4.225   |  66.75   |
 7 | H1 | 134.85| 3.725 | 64.125|  148.85  |  5.355   |  69.85   |

那么...执行此操作的最佳方法是什么？我可以添加到现有的宏来执行此操作吗？如果是这样，最好修改数组吗？ ...更好地修改复制例程？ ...怎么办？

预先感谢您的帮助，请不要建议手动执行此操作。有 70,000 多行需要解析！

如果您需要更多信息，请告诉我！

原文

I found a macro (courtesy of Jerry Beaucaire) that splits up one worksheet into many based on unique values in a given column. This works great. However...

The client has supplied a differently formatted worksheet which needs some gentle massaging to get into the format we need.

First, let me show you a snippet of JB's code:

MyArr = Application.WorksheetFunction.Transpose _
    (ws.Columns(iCol).SpecialCells(xlCellTypeConstants))

From what I can tell (and I'm a total VB newbie, so what do I know..??), this populates an array with the selected row values

And this:

For Itm = 2 To UBound(MyArr)

    ...(code removed)

    ws.Range("A" & TitleRow & ":A" & LR).EntireRow.Copy _
        Sheets(MyArr(Itm) & "").Range("A1")


    ...(code removed)

Next Itm

...seems to do the copying.

Alright. ...fine so far.

The problem is that I need to add a step to the process. This will be tricky to explain. Please bear with me...

Title row is row 1

Data starts in row 2

Each row has 9 columns:

colA: identifier

colB-colD: x,y,z values (for top of item)

colE-colG: x,y,z values (for bottom of item)

colH and colI: can be ignored

These x,y and z values are used to define points that are used to plot lines in a 3D modelling program. Each row in the worksheet actually defines a line (well... a start point and an end point - "top" and "bottom") Unfortunately, the data(worksheet) we have received defines two sets of data for each line - both having the same start point, but with different end points. Put another way, starting with rows 3 and 4, the data in columns B-D is the same for both rows. This applies to rows 5 & 6, 7 & 8, etc.

Since all we need are a set of data POINTS, we can safely use the values from cols E-G.
HOWEVER... and this is where I need help... We need the first row of the newly created worksheet to start with the values from row 2, cols B-D. (ie. we can use the end points as our coordinates, but we still need the first start point) All the rest is fine the way it is.

For example:

Source Data:

   | A  |   B   |   C   |   D   |     E    |     F    |     G    |
 1 | id | x-top | y-top | z-top | x-bottom | y-bottom | z-bottom |
 2 | H1 | 101.2 | 0.525 | 54.25 |  110.25  |  0.625   |  56.75   |
 3 | H1 | 110.25| 0.625 | 56.75 |  121.35  |  2.125   |  62.65   |
 4 | H1 | 110.25| 0.625 | 56.75 |  134.85  |  3.725   |  64.125  |  B,C,D same as row 3
 5 | H1 | 134.85| 3.725 | 64.125|  141.25  |  4.225   |  66.75   |
 6 | H1 | 134.85| 3.725 | 64.125|  148.85  |  5.355   |  69.85   |  B,C,D same as row 5

What I need:

   | A  |   B   |   C   |   D   |     E    |     F    |     G    |
 1 | id | x-top | y-top | z-top | x-bottom | y-bottom | z-bottom |
 2 | H1 |       |       |       |  101.2   |  0.525   |  54.25   |
 3 | H1 | 101.2 | 0.525 | 54.25 |  110.25  |  0.625   |  56.75   |
 4 | H1 | 110.25| 0.625 | 56.75 |  121.35  |  2.125   |  62.65   |
 5 | H1 | 110.25| 0.625 | 56.75 |  134.85  |  3.725   |  64.125  |
 6 | H1 | 134.85| 3.725 | 64.125|  141.25  |  4.225   |  66.75   |
 7 | H1 | 134.85| 3.725 | 64.125|  148.85  |  5.355   |  69.85   |

So... What's the best way to do this? Can I add to the existing macro to perform this operation? If so, better to modify the array? ...better to modify the Copy routine? ...and how??

Thanks in advance for your help and please don't suggest doing it manually. There are 70,000+ rows to parse!

If you need more info, let me know!

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

莫言歌 2024-12-27 09:11:03

完整的宏可免费提供给所有人：这个location

为了实现您的连接点，这些添加应该可以做到：

For Itm = 2 To UBound(MyArr)

    ...(code removed)

    ws.Range("A" & TitleRow & ":A" & LR).EntireRow.Copy _
      Sheets(MyArr(Itm) & "").Range("A1")
    Sheets(MyArr(Itm) & "").Rows(2).Insert xlShiftDown
    Sheets(MyArr(Itm) & "").Range("E2").Resize(, 3).Value = Sheets(MyArr(Itm) & "").Range("B3").Resize(, 3).Value

    ...(code removed)

Next Itm

The full macro is available for free to all at this location

To achieve your connecting points, these additions should do it:

For Itm = 2 To UBound(MyArr)

    ...(code removed)

    ws.Range("A" & TitleRow & ":A" & LR).EntireRow.Copy _
      Sheets(MyArr(Itm) & "").Range("A1")
    Sheets(MyArr(Itm) & "").Rows(2).Insert xlShiftDown
    Sheets(MyArr(Itm) & "").Range("E2").Resize(, 3).Value = Sheets(MyArr(Itm) & "").Range("B3").Resize(, 3).Value

    ...(code removed)

Next Itm

回复收藏 0 原文

~没有更多了~