查找关键字并从相同字段中擦除文本以转换为date

我想解决如何创build一个Excel函数，将在定义的列中的任何行中find一个关键字，然后将在同一字段（以dd / mm / yy格式）中刮擦文本，将其转换为date在新的专栏。

字段数据示例['Keyword'，13/10/17]

这可能在Excel中吗？ 会需要VBA吗？

谢谢

Answer 1

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

总是在代码模块的声明头中使用Option Explicitexpression式声明variables。 过程代码显示了使用数据字段数组而不是循环遍历范围的快速方法。 您可以通过此示例代码轻松地将范围值设置为variables数组：

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

通过这种方式，你可以加快你的search。 请记住，VBA然后自动创build一个基于Dimension 2的数组。

下面的程序是什么？

• 在列A中search“关键字”
• 得到col B的string（“13/10/17”），转换为date和
• 在工作表testing中将date写入col C.

testing呼叫

 Option Explicit 

'注意：将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, eg "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 eg "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）我假设你在第一行有一个标题行。

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

    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）如果你想要search大小写敏感，你必须改变代码如下：

  If a(i, 1) = sKey而不是If LCase(a(i, 1)) = LCase(sKey)

祝你好运。

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

在同一列中的单元格内search和数据编辑示例（冒号分隔）

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

在一列中编辑search程序

 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, eg "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 eg "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