串联数据描述并与数据范围对齐



我一直在尝试学习视觉基本以编写代码以在Excel中使用数据时执行任务。我主要是在复制我在网上找到的代码段并将它们拼凑在一起。目前,我有包含10个.csv文件的10个文件夹(来自CMM的数据输出(。

在这些文件中的每个列中,A始终包含数据的标签,B列始终包含CMM数据。

当前,我的程序允许用户选择多个.csv文件,并且以较长的回旋方式选择它们最终都在Excel的一个工作表中使用第一列中的数据标签和下一列中的数据。

例如,如果打开了10个CSV文件,则数据标签将在第一列中,并且数据将在接下来的10列中。

问题在于,数据标签与数据不符,并且每行数据都有多个标签。

我已经能够将数据标签连接到每行数据的一个标签中,但无法弄清楚如何将此标签与数据行对齐。

在这一点上,我会对完成此操作的单独代码块感到满意,但是...我怀疑我的代码块连接标签可以轻松修改以完成任务,我只是没有去过能够弄清楚。

所以我的代码吐出了:

(Flatness) : Item (113)
Plane:RH_5_Mating_Surface
                                                             5.012  4.014  6.313  etc...
(Z) : Item (128) / (X) : Item (135)
Circle:Offset_Dowel_Hole
                                                             1.012  2.987  5.478  etc...
Circle:Cast_Hole_From_Offset_Dowel_Hole
                                                             2.147  7.895  4.258  etc...

然后,此代码将标签串联并在B列中吐出来:

Dim rng1 As Range
Dim Lastrow As Long
Dim c As Range
Dim concat As String
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
Set rng1 = Range("A9:A" & Lastrow)   
concat = ""
For Each c In rng1
If c > 0 Then
    concat = concat & " " & c.Value
    concat = Trim(concat)
Else
    c.Offset(-1, 1).Value = concat
    concat = ""
End If
Next c

结果是:

(Flatness) : Item (113) Plane:RH_5_Mating_Surface
                                                             5.012  4.014  6.313  etc...

(Z) : Item (128) / (X) : Item (135) Circle:Offset_Dowel_Hole
                                                             1.012  2.987  5.478  etc...
Circle:Cast_Hole_From_Offset_Dowel_Hole
                                                             2.147  7.895  4.258  etc...

我需要的是:

我无法弄清楚如何在这里显示它,但是...

我需要行匹配的行,还请注意,这里表明数据和标签被相同的数量所抵消,但实际上不是。所以我的想法是我需要它搜索包含数据的下一行并将标签放在旁边。

我觉得我可以改变这一部分...

Else
    c.Offset(-1, 1).Value = concat

,但我不知道该怎么做...

我尝试在这里嵌套另一个"为每个"嵌套,而不是它已经在做什么,但是在rng2中的每个d中," rng2"是数据列,它将寻找下一行带有数据和位置"使用" D.offset(-1,-1(.value = Concat"

concat" concat"

我不知道如何使它起作用...

这是一种可能的方法。删除空单元格并在列中移动。如果数据顺序是一致的,则应正确对齐。

For i=1 to Lastrow
    If Range("A" & i).Value=""
        Range("A" & i).Delete Shift:=xlUp
    End If
    If Range("B" & i).Value=""
        Range("B" & i).Delete Shift:=xlUp
    End If
Next

您可以根据工作表更改范围。另外,修改代码以使用其他" IF"条件检查空白,如果对您的情况有效。

最新更新