Question

我试图在工作表上创建一个从不同工作表中提取数据的关联表。通过关联我的意思是，如果在源数据表中更改了数据，它将反映在新工作表上。我还想让新表的表格取决于具有一定的独特价值。就我而言，我想提取与零件号相关的信息。原始源数据将包含许多包含相同部件号的行，但我只关心显示其中一个。

这是我到目前为止所做的：

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Dim ref() As Variant
Dim row As Integer
row = 92
Worksheets("Part Tracking Scorecard").Activate
While Cells(row, 6).Value:
    If IsInArray(Cells(row, 6).Value, ref) Then
        row = row + 1
    ElseIf Not IsInArray(Cells(row, 6).Value, ref) Then
        ReDim Preserve ref(1 To UBound(ref) + 1) As Variant
        ref(UBound(ref)) = Cells(row, 6).Value
        Worksheets("Unique Parts").Activate
        ?????
        row = row + 1

为了满足我的条件只显示唯一的部件号，我初始化了一个名为＆＃34; ref＆＃34;的空数组。然后，当我遍历源表时，我会使用函数＆＃34; IsInArray＆＃34;来检查部件号是否在ref中。如果它在其中，它将移动到下一行，如果它没有将零件号添加到空数组中并移动到下一行。

＆＃34; ????＆＃34;是我的大部分问题试图解决的问题。该部分应该是我使用唯一部件号中的日期创建新表的位置。我能做的非常简单和乏味的事情就是让一些循环遍历行的列并放入一个vlookup函数。我想知道这样做是否有更强大或更优雅的方式。

Answer 1

你有合适的反射力来定义一个数组来存储你的价值观。以下是我将如何解决的一些提示（不完美，但它应该帮助你）：

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
   IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Dim Source as Worksheets
Set Source = Worksheets("Part Tracking Scoreboard")
Dim ref1(), ref2() As Variant
Dim row, index, index2 As Integer

row = 92

ref1 = Source.Range(Worksheets(Source.Cells(row,1), Source.Cells(lastrow, last column))
'Start by placing your ENTIRE source sheet in ref1, if your source sheet is big, this will help you win A LOT of time during the looping phase. Notice how I start from row 92 seeing as this is where you started your loop
'lastrow and lastcolumn represent the position of the last cell in your source file

For index = row to lastrow
    If Not IsInArray(ref1(row, 6).Value, ref2) Then  
        ref2(index) = ref1(index) 'copy the entire row from source to ref2
Next index

Dim NewFile as Worksheet
Set Newfile = Sheets("NewSheetName")

Dim ref2dimension_x, ref2dimension_y as Integer 'find dimensions of ref2 array
ref2dimension_x= UBound(ref2, 1) - LBound(ref2, 1) + 1
ref2dimension_y = UBound(ref2, 2) - LBound(ref2, 2) + 1

For index = 2 to ref2dimension_x 'go through entire new sheet and set values
    For index2 = 1 to ref2dimension_y
        NewFile.Cells(index, index2).Value = ref2(index - 1, index2)
    Next index2
Next index

ref1() = nothing
ref2() = nothing 'free up the space occupied by these arrays

我不确定你在else循环中想要做什么。如果您打算复制整行，这应该可行。如果您只想从源表中复制特定数据，则需要查找相应列的索引（如果它们不打算进行硬编码，或者使用循环通过字符串比较来查找它们）。

Answer 2

此解决方案结合了我经常使用的一些宏（因此，即使您现在不使用它们，它们将来可能会有所帮助）。如果唯一表中的数据需要＆＃34; live＆＃34;，如果它足以在每次打开/关闭工作簿时（或者在工作簿上）更新它，那么它将无法工作需求），这比阵列版本复杂得多。

基本上你只是：

将主要/非重复表格复制到新表格
按部件号
从未重复的表中删除不必要的列（如果适用）

我假设您的源数据位于正式的Excel表（ListObject）中。只需换掉＆＃34; PartTable＆＃34;无论您的实际表格被调用。

isValid(...)

制作唯一标识符的关联表

2 个答案: