Vba 在二维数组中查找现有字符串_Vba_Excel

Vba 在二维数组中查找现有字符串

vba excel

Vba 在二维数组中查找现有字符串,vba,excel,Vba,Excel,我从电子表格中收集数据并将其存储在二维数组中，其思想是，一旦脚本检测到它正在从特定列读取数据，它将不会读取整行数据（因为这将被视为重复）代码： Private Sub LoadData() cDOC_DEBUG "Loading document data..." Dim x As Long 'Column Data - there is another function that reads when x = 0 = header; else every other valu

我从电子表格中收集数据并将其存储在二维数组中，其思想是，一旦脚本检测到它正在从特定列读取数据，它将不会读取整行数据（因为这将被视为重复）

代码：

Private Sub LoadData()

   cDOC_DEBUG "Loading document data..."
   Dim x As Long  'Column Data - there is another function that reads when x = 0 = header; else every other value is considered "data"
   Dim y As Long 

   With dataWS
      For x = 1 To LR - 1
         For y = 1 To LC - 1
            If (IsInArray(.Cells(x + 1, y + 1).value, pData())) Then
               cDOC_DEBUG "Added: " & .Cells(x + 1, y + 1).value
               pData(x, y) = Trim(.Cells(x + 1, y + 1).value)
            End If
         Next y
      Next x
   End With

End Sub

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

Private Sub cDOC_DEBUG(debugText As String)
   If (ThisWorkbook.Worksheets("Settings").Cells(3, 2)) Then
      Debug.Print debugText
   End If
End Sub

        A           B           C           D
1    header1     header2     header3     header4
2       a           b           c           d
3       w           x           y           z
4       a           h           j           j
5       a           b           j           d
6       w           x           u           z

        0           1           2           3
0    header1     header2     header3     header4
1       a           b           c           d
2       w           x           y           z
3       a           h           j           j

在我开始实现我的

IsInArray

函数之前，一切都很好地加载到数组中。我可以看出这与它在一维数组中搜索有关，而我的数组是二维的；所以它得到一个类型不匹配错误是有道理的

电子表格中的每一行都是与其自身相关的一段信息

电子表格中的初始数据：

Private Sub LoadData()

   cDOC_DEBUG "Loading document data..."
   Dim x As Long  'Column Data - there is another function that reads when x = 0 = header; else every other value is considered "data"
   Dim y As Long 

   With dataWS
      For x = 1 To LR - 1
         For y = 1 To LC - 1
            If (IsInArray(.Cells(x + 1, y + 1).value, pData())) Then
               cDOC_DEBUG "Added: " & .Cells(x + 1, y + 1).value
               pData(x, y) = Trim(.Cells(x + 1, y + 1).value)
            End If
         Next y
      Next x
   End With

End Sub

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

Private Sub cDOC_DEBUG(debugText As String)
   If (ThisWorkbook.Worksheets("Settings").Cells(3, 2)) Then
      Debug.Print debugText
   End If
End Sub

        A           B           C           D
1    header1     header2     header3     header4
2       a           b           c           d
3       w           x           y           z
4       a           h           j           j
5       a           b           j           d
6       w           x           u           z

        0           1           2           3
0    header1     header2     header3     header4
1       a           b           c           d
2       w           x           y           z
3       a           h           j           j

2x2最终阵列：

Private Sub LoadData()

   cDOC_DEBUG "Loading document data..."
   Dim x As Long  'Column Data - there is another function that reads when x = 0 = header; else every other value is considered "data"
   Dim y As Long 

   With dataWS
      For x = 1 To LR - 1
         For y = 1 To LC - 1
            If (IsInArray(.Cells(x + 1, y + 1).value, pData())) Then
               cDOC_DEBUG "Added: " & .Cells(x + 1, y + 1).value
               pData(x, y) = Trim(.Cells(x + 1, y + 1).value)
            End If
         Next y
      Next x
   End With

End Sub

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

Private Sub cDOC_DEBUG(debugText As String)
   If (ThisWorkbook.Worksheets("Settings").Cells(3, 2)) Then
      Debug.Print debugText
   End If
End Sub

        A           B           C           D
1    header1     header2     header3     header4
2       a           b           c           d
3       w           x           y           z
4       a           h           j           j
5       a           b           j           d
6       w           x           u           z

        0           1           2           3
0    header1     header2     header3     header4
1       a           b           c           d
2       w           x           y           z
3       a           h           j           j

由于Excel第5行和第6行的Header1、Header2和Header4与Excel第2行和第3行的值相同，因此不会将其读入数组

问题：

Private Sub LoadData()

   cDOC_DEBUG "Loading document data..."
   Dim x As Long  'Column Data - there is another function that reads when x = 0 = header; else every other value is considered "data"
   Dim y As Long 

   With dataWS
      For x = 1 To LR - 1
         For y = 1 To LC - 1
            If (IsInArray(.Cells(x + 1, y + 1).value, pData())) Then
               cDOC_DEBUG "Added: " & .Cells(x + 1, y + 1).value
               pData(x, y) = Trim(.Cells(x + 1, y + 1).value)
            End If
         Next y
      Next x
   End With

End Sub

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

Private Sub cDOC_DEBUG(debugText As String)
   If (ThisWorkbook.Worksheets("Settings").Cells(3, 2)) Then
      Debug.Print debugText
   End If
End Sub

        A           B           C           D
1    header1     header2     header3     header4
2       a           b           c           d
3       w           x           y           z
4       a           h           j           j
5       a           b           j           d
6       w           x           u           z

        0           1           2           3
0    header1     header2     header3     header4
1       a           b           c           d
2       w           x           y           z
3       a           h           j           j

如何匹配上述条件以不包含行中的重复项

Sudo代码示例：

Private Sub LoadData()

   cDOC_DEBUG "Loading document data..."
   Dim x As Long  'Column Data - there is another function that reads when x = 0 = header; else every other value is considered "data"
   Dim y As Long 

   With dataWS
      For x = 1 To LR - 1
         For y = 1 To LC - 1
            If (IsInArray(.Cells(x + 1, y + 1).value, pData())) Then
               cDOC_DEBUG "Added: " & .Cells(x + 1, y + 1).value
               pData(x, y) = Trim(.Cells(x + 1, y + 1).value)
            End If
         Next y
      Next x
   End With

End Sub

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

Private Sub cDOC_DEBUG(debugText As String)
   If (ThisWorkbook.Worksheets("Settings").Cells(3, 2)) Then
      Debug.Print debugText
   End If
End Sub

        A           B           C           D
1    header1     header2     header3     header4
2       a           b           c           d
3       w           x           y           z
4       a           h           j           j
5       a           b           j           d
6       w           x           u           z

        0           1           2           3
0    header1     header2     header3     header4
1       a           b           c           d
2       w           x           y           z
3       a           h           j           j

如果（要添加的值）与列Header1、Header2和Header3中的所有值匹配，则

不添加到数组中

我知道的另一个问题是，此数组中会有空白数据；我可以做些什么来删除这些数据，还是必须为数组插槽创建另一个索引来跟踪这些数据？

您可以循环行/列，并使用

索引从数组中切片行/列，然后使用匹配进行测试如果搜索值在该列中。请与计数
组合以测试重复项。如果计数等于列数，则忽略值（或列计数-1…请参阅下一条注释==>）。不完全确定此虚拟列。是否打算在开始时使用额外的空列进行尺寸标注
行版本：
Private Sub LoadData()

   cDOC_DEBUG "Loading document data..."
   Dim x As Long  'Column Data - there is another function that reads when x = 0 = header; else every other value is considered "data"
   Dim y As Long 

   With dataWS
      For x = 1 To LR - 1
         For y = 1 To LC - 1
            If (IsInArray(.Cells(x + 1, y + 1).value, pData())) Then
               cDOC_DEBUG "Added: " & .Cells(x + 1, y + 1).value
               pData(x, y) = Trim(.Cells(x + 1, y + 1).value)
            End If
         Next y
      Next x
   End With

End Sub

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

Private Sub cDOC_DEBUG(debugText As String)
   If (ThisWorkbook.Worksheets("Settings").Cells(3, 2)) Then
      Debug.Print debugText
   End If
End Sub

        A           B           C           D
1    header1     header2     header3     header4
2       a           b           c           d
3       w           x           y           z
4       a           h           j           j
5       a           b           j           d
6       w           x           u           z

        0           1           2           3
0    header1     header2     header3     header4
1       a           b           c           d
2       w           x           y           z
3       a           h           j           j

存在：
Option Explicit
Public Sub CheckRow()
    Dim arr(), i As Long
    arr = [A1:D6].Value                          '<==2D array created

    For i = LBound(arr, 1) To UBound(arr, 1)     '<== loop rows
        'look in each row for x and if found exit loop and indicate row where found
        If Not IsError(Application.Match("x", Application.WorksheetFunction.Index(arr, i, 0), 0)) Then
            Debug.Print "value found in column " & i
            Exit For
        End If
    Next
End Sub

Option Explicit
Public Sub CheckColumn()
    Dim arr(), i As Long
    arr = [A1:D6].Value                          '<==2D array created

    For i = LBound(arr, 2) To UBound(arr, 2)     '<== loop columns
        'look in each column for x and if found exit loop and indicate column where found
        If Not IsError(Application.Match("x", Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, i)), 0)) Then
            Debug.Print "value found in column " & i
            Exit For
        End If
    Next
End Sub


使用工作表中的样本数据：
使用高级索引的备选方案
功能
如果数据行数不超过65536，使用（后期绑定）字典的这种方法应该会有所帮助。您将得到一个2维（基于1）数组v
，其中包含列a、B和D的唯一数据集
在本例中，代码结果被写回F:H列，而C列的值被省略；如果您想保持这些值，请参阅► 编辑下面的
示例代码（在结果数组中省略C列）
为了澄清，这被称为二维（或二维）数组。（我认为2x2意味着总共有4个元素，即，A1:B2
）。除此之外-可能我不完全理解您在这里对“重复”的定义-您想删除“头3”所在的行是否重复？@ashleedawg抱歉，是的，您是正确的，这是一个二维数组。为了澄清，如果在Header1、Header2和Header3中发现重复值，则不会将此项添加到数组中。在示例中，您可以看到第5行和第6行被分类为重复行，因此不包含在数组中。数组第5行等于Excel第2行和Ar行ray第6行等同于Excel第3行。我认为有一种比使用VBA更简单的方法，但我仍然不清楚。如果标题1、标题2或标题3有重复项？…我不明白，因为第一列中仍然有重复项。@ashleedawg我不是在比较单行中的单个值，而是在相互比较行。第5行等于第2行，因此未包含在最终数组中。第6行等于第3行，因此未包含在最终数组中。仅使用A、B和D列；C列未包含在标准中。我要查找行并将行切掉，而不是列…我不确定这是否符合我要查找的内容。您的措辞是“我如何搜索整个（理论上的）列”-所以肯定是行？我可以很容易地更改为行。@QHarr-wouldn“删除重复项”“简单多了？我不清楚细节-你可能每次都要运行3次，选择一个专栏..或者可能我完全误解了？很抱歉，我已经对问题进行了编辑，以便更具体地了解我正在寻找的内容for@ashleedawg我不知道了。如果OP可以使用上面的伟大。否则，我可以删除并去抓取一个