Excel 存储和检索单元格详细信息的快速方法-VBA

我是初学者。对于我的VBA项目，在我的第8行中，我有40多个包含内容的列。我想检查单元格是否包含所需内容，如果是，我想将该单元格列位置存储在变量中

目前我正在使用for循环来实现这一点。我的问题是，是否有任何方法可以快速执行此操作，并将列值存储在数组中，稍后再检索

我在这里使用的代码是

rowposition =8

lastcol = ws1.Cells(8, Columns.Count).End(xlToLeft).Column

For findval = 1 To lastcol

If ws1.Cells(rowposition, findval).Value = "Sl.No" Then
    slno = ws1.Cells(rowposition, findval).Column
    ws1.Range("CQ9:CQ9").Value = slno
    
    ElseIf ws1.Cells(rowposition, findval).Value = "PIF No." Then
    pif = ws1.Cells(rowposition, findval).Column
    ws1.Range("CE9:CE9").Value = pif
    
    ElseIf ws1.Cells(rowposition, findval).Value = "Vertical" Then
    verticals = ws1.Cells(rowposition, findval).Column
    ws1.Range("CM9:CM9").Value = verticals
.
.
.
.
.so on......

If slno =Empty or pif = Empty Or verical= Empty Or Then

MsgBox ("Columns have been modified please check")

exit sub

End If

---

你应该把整张纸读成一个数组，然后循环读一遍。这将是一个更快的数量级。（Carful，该数组将从索引1开始-使用LBound到UBound进行迭代）

您只需在找到值时存储findval的值

If sheetArray(rowposition, findval)= "Sl.No" Then
    slno = findval
    ws1.Range("CQ9:CQ9").Value = slno

一个数组的值在另一个数组中的位置

• 测试值为

  PIF编号、垂直、Sl.No

  ，范围为

  A8:C8

  <代码>测试是一个未找到的值

代码

Option Explicit

Sub writePositions()

    ' Initial is a 1D zero-based array.
    ' Current is a 2D one-based (one-row) array.
    ' Positions is a 1D one-based array.

    ' Define constants.        
    Const HeaderRow As Long = 8
    Const FirstCol As Long = 1
    ' Define Initial Header Array.
    Dim Initial As Variant
    ' VBA.Array is ensuring 0-based.
    Initial = VBA.Array("Sl.No", "Test", "PIF No.", "Vertical") ' add more.
    
    ' Define worksheet.
    Dim ws1 As Worksheet
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    ' Define Last Column in header row.
    Dim LastCol As Long
    LastCol = ws1.Cells(HeaderRow, ws1.Columns.Count).End(xlToLeft).Column
    ' Define Current Header Range.
    Dim rng As Range
    Set rng = ws1.Cells(HeaderRow, FirstCol).Resize(1, LastCol - FirstCol + 1)
    ' Write values from Current Header Range to Current Header Array.
    Dim Current As Variant
    Current = rng.Value
    
    ' Declare additional variables.
    Dim Positions As Variant
    Dim j As Long
    
    ' Write the positions of the values of Initial Header Array
    ' found in Current Header Array, to Positions Array.
    ' Note that Positions will contain error values for all the values
    ' of Initial not found in Current.
    Positions = Application.Match(Initial, Current, 0)
    
    ' View the results in the Immediate window (VBE: CRTL+G):
    Debug.Print "Initial:"
    Debug.Print "Index", "Initial", "Position in Current"
    For j = 0 To UBound(Initial)
        If IsNumeric(Positions(j + 1)) Then
            Debug.Print j + 1, Initial(j), Positions(j + 1)
        Else
            Debug.Print j + 1, Initial(j), "Not found"
        End If
    Next j

    ' The other way around.
    
    ' Write the positions of the values of Current Header Array
    ' found in Initial Header Array, to Positions Array.
    ' Note that Positions will contain error values for all the values
    ' of Current not found in Initial.
    Positions = Application.Match(Current, Initial, 0)
    
    ' View the results in the Immediate window (VBE: CRTL+G):
    Debug.Print "Current:"
    Debug.Print "Index", "Current", "Position in Initial"
    For j = 1 To UBound(Current, 2)
        If IsNumeric(Positions(j)) Then
            Debug.Print j, Current(1, j), Positions(j)
        Else
            Debug.Print j, Current(1, j), "Not found"
        End If
    Next j

End Sub

---

目前尚不清楚单元格列位置和单个数组的含义。例如，这是否意味着您有一个字符串列表，例如

aList=“Sl.No，PIF No.，Vertical”

，如果在

F，C，a列中找到它们，您希望在数组中返回
6,3,1
？此外，行有点混乱：在文本中使用行
8
，而在代码中使用
7
（用于计算最后一列）和
9
（用于“搜索”）。请澄清。对不起，不清楚。内容在第8行和A、B、C等列中找到。如果满足条件，列位置应存储在数组中并检索以供以后使用注意，我已进行了更正：
ws1.columns.Count
而不是
columns.Count
。您是否可以提供此问题的解决方案。很抱歉，我还不知道有关Outlook的任何信息。谢谢您的回复。保存excel文件时，我很难向远程服务器/计算机发送电子邮件通知。到目前为止没有有用的线索，这就是为什么问你
Option Explicit

Sub writePositions()

    ' Initial is a 1D zero-based array.
    ' Current is a 2D one-based (one-row) array.
    ' Positions is a 1D one-based array.

    ' Define constants.        
    Const HeaderRow As Long = 8
    Const FirstCol As Long = 1
    ' Define Initial Header Array.
    Dim Initial As Variant
    ' VBA.Array is ensuring 0-based.
    Initial = VBA.Array("Sl.No", "Test", "PIF No.", "Vertical") ' add more.
    
    ' Define worksheet.
    Dim ws1 As Worksheet
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    ' Define Last Column in header row.
    Dim LastCol As Long
    LastCol = ws1.Cells(HeaderRow, ws1.Columns.Count).End(xlToLeft).Column
    ' Define Current Header Range.
    Dim rng As Range
    Set rng = ws1.Cells(HeaderRow, FirstCol).Resize(1, LastCol - FirstCol + 1)
    ' Write values from Current Header Range to Current Header Array.
    Dim Current As Variant
    Current = rng.Value
    
    ' Declare additional variables.
    Dim Positions As Variant
    Dim j As Long
    
    ' Write the positions of the values of Initial Header Array
    ' found in Current Header Array, to Positions Array.
    ' Note that Positions will contain error values for all the values
    ' of Initial not found in Current.
    Positions = Application.Match(Initial, Current, 0)
    
    ' View the results in the Immediate window (VBE: CRTL+G):
    Debug.Print "Initial:"
    Debug.Print "Index", "Initial", "Position in Current"
    For j = 0 To UBound(Initial)
        If IsNumeric(Positions(j + 1)) Then
            Debug.Print j + 1, Initial(j), Positions(j + 1)
        Else
            Debug.Print j + 1, Initial(j), "Not found"
        End If
    Next j

    ' The other way around.
    
    ' Write the positions of the values of Current Header Array
    ' found in Initial Header Array, to Positions Array.
    ' Note that Positions will contain error values for all the values
    ' of Current not found in Initial.
    Positions = Application.Match(Current, Initial, 0)
    
    ' View the results in the Immediate window (VBE: CRTL+G):
    Debug.Print "Current:"
    Debug.Print "Index", "Current", "Position in Initial"
    For j = 1 To UBound(Current, 2)
        If IsNumeric(Positions(j)) Then
            Debug.Print j, Current(1, j), Positions(j)
        Else
            Debug.Print j, Current(1, j), "Not found"
        End If
    Next j

End Sub