Question

我正在尝试研究如何创建一个Excel函数，该函数将在定义的列中的任何行中找到关键字，然后将在同一字段中刮取文本（以dd / mm / yy格式），将其转换为在新专栏中注明日期。

现场数据示例['Keyword'，13/10/17]

这可以在Excel中使用吗？会不会需要VBA？

由于

Answer 1

使用数据字段数组的示例：

始终使用代码模块的声明头中的Option Explicit表达式声明变量。过程代码向您显示使用数据字段数组的快速方法，而不是循环遍历范围。您可以通过以下示例代码轻松地将范围值设置为变量数组：

Dim a         ' variant
a = ThisWorkbook.Range("A2:A4711").value

通过这种方式，您可以加快搜索速度。请记住，VBA会自动创建一个基于Dimension 2的基于数组的数组。

以下程序是什么？

搜索＆＃34;关键字＆＃34;在col A，
获取col B的字符串（＆＃34; 13/10/17＆＃34;），转换为日期和
将日期写入表格测试中的col C

测试电话

Option Explicit

＆＃39;注意：将Option Explicit写入代码模块的声明头

Sub TestCall()
' Example
  writeKeyDate "Keyword", "A", "B", "C", "Test"
End Sub

程序代码

Sub writeKeyDate(ByVal sKey As String, _
                 ByVal sCol As String, ByVal sCol2 As String, ByVal sCol3 As String, _
                 Optional ByVal wsName As String = "Test")
'     sKey .... search string
'     sCol .... character of column where to search
'     sCol2 ... character of column with datestring
'     sCol3 ... character of target column
'     wsName .. worksheet name as string, e.g. "MySheet", or "Test"
'               (if not set, then automatically "Test")
' declare vars
  Dim oSht    As Worksheet                       ' work sheet
  Dim a       As Variant                         ' one based 2-dim data field array
  Dim i       As Long                            ' rows
  Dim n       As Long                            ' last row
  Dim sDate   As String                          ' date string in sCol2
' set sheet
  Set oSht = ThisWorkbook.Worksheets(wsName)     ' fully qualified reference to worksheet
' get last row number of search column
  n = oSht.Range(sCol & oSht.Rows.Count).End(xlUp).Row
  If n < 2 Then Exit Sub                         ' only if data avaible (row 1 assumed as head line)

' get range values to one based 2dim data field array
  a = oSht.Range(sCol & "2:" & sCol & n).Value    '  array gets data from e.g. "A2:A100"
' loop through column sCol to find keyword sKey
  For i = LBound(a) To UBound(a)              '  array boundaries counting from 1 to n -1 (one off for title line)
      ' searchstring found
        If LCase(a(i, 1)) = LCase(sKey) Then  '  case insensitive
           sDate = oSht.Range(sCol2 & i + 1).Value2
           On Error Resume Next
           If Len(Trim(sDate)) > 0 Then
              oSht.Range(sCol3 & i + 1).Value = CDate(sDate)
           End If
        End If
  Next

End Sub

注意

a）我假设你在第1行有一个标题行。

b）该过程回写任何代码查找（不区分大小写）;如果您只有唯一键，则可以在上一个Exit For条件中包含If：

   If Len(Trim(sDate)) > 0 Then
      oSht.Range(sCol3 & i + 1).Value = CDate(sDate)
   '  >>>> possible insert, if unique keys only >>>>
      Exit For
   End If

c）如果您希望搜索区分大小写，则必须按如下方式更改代码：

If a(i, 1) = sKey代替If LCase(a(i, 1)) = LCase(sKey)

祝你好运。

============================================

同一列中单元格内的搜索和数据的EDIT示例（冒号分隔）

Sub TestCall1()
' Example
  writeKeyDate1 "Keyword", "A", "B", "Test"
End Sub

在一栏中编辑了搜索程序

Sub writeKeyDate1(ByVal skey As String, _
                 ByVal sCol As String, ByVal sCol2 As String, _
                 Optional ByVal wsName As String = "Test")
'     sKey .... search string
'     sCol .... character of column where to search (includes key, date string)
'     sCol2 ... character of target column
'     wsName .. worksheet name as string, e.g. "MySheet", or "Test"
'               (if not set, then automatically "Test")
' declare vars
  Dim oSht    As Worksheet                       ' work sheet
  Dim a       As Variant                         ' one based 2-dim data field array
  Dim i       As Long                            ' rows
  Dim n       As Long                            ' last row
  Dim s       As String
  Dim sDate   As String                          ' date string in sCol2
' set sheet
  Set oSht = ThisWorkbook.Worksheets(wsName)     ' fully qualified reference to worksheet
' get last row number of search column
  n = oSht.Range(sCol & oSht.Rows.Count).End(xlUp).Row
  If n < 2 Then Exit Sub                         ' only if data avaible (row 1 assumed as head line)

' get range values to one based 2dim data field array
  a = oSht.Range(sCol & "2:" & sCol & n).Value    '  array gets data from e.g. "A2:A100"
' loop through column sCol to find keyword sKey
  For i = LBound(a) To UBound(a)              '  array boundaries counting from 1 to n -1 (one off for title line)
        s = Split(LCase(a(i, 1)) & "", ",")(0)
      ' searchstring found
        If InStr(LCase(s), LCase(skey)) > 0 Then
           sDate = Trim(Split(LCase(a(i, 1)) & ",", ",")(1))
           On Error Resume Next
           If Len(sDate) > 0 Then
              oSht.Range(sCol2 & i + 1).Value = CDate(sDate)
           End If
        End If
  Next

End Sub

查找关键字并从同一字段中删除文本以转换为日期

1 个答案: