根据字符串中字符的位置删除列

Question

我还是VBA的新手，到目前为止还找不到任何使用搜索功能的解决方案。 问题： 我有（在这种情况下，十张）一行超过500单元格包含5-7个字的字符串。 现在我需要删除搜索到的单词不是最后一个单词的所有列，但是该单词在字符串中不同位置的所有单元格（行中）。 我尝试这样做：

Dim examinee As Variant 
Dim cell As Range 
Dim word As String 
Dim myCell As String 

examinee = InputBox("How many sheets?") 
word = InputBox("Looking for?") 

For A = 1 To examinee 

Sheets("sheet" & A).Select 
On Error Resume Next 
Range("A3", Range("A3").End(xlToRight)).Select 
    For Each Cell In Selection.Cells 
     myCell = Right(Cell, Len(Cell) - (InStrRev(Cell, " ") - 1)) 
     MsgBox myCell ' just to be sure the word is found 
     If myCell Like word Then 
     Selection.Cells.Bold = False 
     Else 
     Delete.Column 
     End If 
    Next Cell 
Next 

我能找到&辨别单词和“如果”工作正常，到目前为止，只是什么也没有发生选定单元格和列并没有被删除。 随着一些更改，我只能删除整行，但它不是我所需要的。 任何帮助appriciated。 Thx提前。

Answer 1

这应该工作，但是我建议你清理语法。我已经删除了你选择范围的代码（网上有很多关于你为什么不应该这样做的信息）。

创建一个数组以查找最后一个单词，并对照搜索值进行测试。

Sub Test() 
Dim examinee As Variant 
Dim cell As Range 
Dim word As String 
Dim myCell As String 
Dim arr() As String 
Dim strLastWord As String 

'How Many Sheets Should We Loop? 
examinee = InputBox("How many sheets?") 
'What Word Are We Searching For? 
word = InputBox("Looking for?") 
'Loop Sheets 
For A = 1 To examinee 
    'Loop Cells In Row 3 
    For Each cell In Range("A3", Range("A3").End(xlToRight)) 
     'Get The Value Of The Current Cell 
     myCell = Right(cell, Len(cell) - (InStrRev(cell, " ") - 1)) 
     'Is It A Single Word? 
     If InStr(1, myCell, " ") Then 
      'Several Words. Create An Array Of Individual Words In The Cell 
      arr() = Split(myCell, " ") 
      'Get The Number Of The Last Word 
      strLastWord = arr(UBound(arr)) 
     Else 
      'Single Word. Get The Word 
      strLastWord = myCell 
     End If 
     'Is The Last Word = The Search Word? 
     If strLastWord = word Then 
      'Yes. Make It Bold 
      cell.Font.Bold = True 
     Else 
      'No. Delete The Column 
      Columns(cell.Column).Delete 
     End If 
    Next cell 
Next 

End Sub 

Answer 2

我认为这将有助于你

Sub findtext() 

Dim wsAkt As Worksheet 
Dim i As Integer 
Dim k As Integer 
Dim x As Integer 
Dim strWord As String 
Dim intWord As Integer 

'get the word 
strWord = Application.InputBox("Looking for?") 
'length of word 
intWord = Len(strWord) 
'loop through all worksheets 
For i = 1 To ThisWorkbook.Worksheets.Count 
    'variable for selected worksheet 
    Set wsAkt = ThisWorkbook.Worksheets(i) 
    'get how many columns are in row 3 
    x = wsAkt.Cells(3, wsAkt.Columns.Count).End(xlToLeft).Column 
     'loop through row 3 columns 
     For k = 1 To x 
      'if last Word in cell = the word then it has to have the same length 
      If Right(wsAkt.Cells(3, k), intWord) <> strWord Then 
       'delete selected column 
       wsAkt.Columns(k).Delete 
      End If 
     Next k 
Next i 

End Sub 

（其未测试）