如何检查一个值是否有特定的文本
我有一个超过1000行的表。 在AI列中有一个文字
:IO.Tgr37.Tank37.TT 在F列的“innstigeringer”表中，我有一堆关键字，像第7行的Tgr37和第8行的Tgr10
在列的GI有
Tgr 120, Tgr 600.......
如果文本中有Tgr37或Tgr10，我想在文本中添加一个前缀。 如果文本中有Tgr120或Tgr600，我会在文本中添加另一个前缀。
我试过这个代码：
Dim sCellVal As String sCellVal = Range("A" & ActiveCell.Row).Value Dim FindString As String Dim Rng As Range FindString = sCellVal If Trim(FindString) <> "" Then With Sheets("Innstillinger").Range("F:F") 'searches all of column F Set Rng = .Find(What:=FindString, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then tag_opc.Value = Sheets("Innstillinger").Range("F6") & Range("A" & ActiveCell.Row).Value & ".Value" 'value found Else MsgBox "Nothing found" 'value not found End If End With End If
但它不起作用，当我把我的关键字在列A和文本列F中的“innstillinger”工作表。
对不起，我的英语不好，但我希望你明白我的问题… Excel 2013
你在哪里声明tag_opc对象？
无论如何， .Find方法对于这样的操作来说是一个糟糕的select。 执行你正在做的最有效的方法是将你的数据提取到一个或多个数组中，处理你需要处理的东西，然后将结果转换回他们需要去的地方。
为了使事情变得容易一些，我会build议一个选项B，它是在问题范围内使用For Each循环。
Dim sCellVal As String Dim wsReference As Excel.Worksheet Set wsReference = Worksheets(1) 'or refer to this by name sCellVal = wsReference.Range("A" & ActiveCell.Row).Value Dim wsSearch As Excel.Worksheet Dim rng As Range, cell As Range Set wsSearch = Worksheets(2) 'or refer to this by name Set rng = wsSearch.Range("F:F") If Trim(Len(sCellVal)) <> 0 Then For Each cell In rng 'Perform actions Next cell End If
这应该涵盖你需要做的核心。 不过，我会换出ActiveCell更具体的参考，因为在VBA中的任何active是臭名昭着的。 例如，您可以使用循环在每次迭代中向上递增i值。
尽pipe如此，它对你想在这里做什么有点模糊。 您多次引用“文本”，但不要说明您所指的是哪个“文本”。
你能提供之前和之后的例子吗？ 如果我们可以明确地看到你想要做什么，我们可能会提供更好的答案。
今天我已经尝试了各种各样的伎俩，我很接近，但是没有…我已经删除了所有的东西，然后回来开始。 这是我的代码：
Private Sub UserForm_Initialize() 'Autofyll userform nr = Sheets("Innstillinger").Range("D8") tag_opc.Value = Range("A" & ActiveCell.Row).Value unit.Value = Range("G" & ActiveCell.Row).Value min.Value = Range("F" & ActiveCell.Row).Value max.Value = Range("E" & ActiveCell.Row).Value io.Value = Range("D" & ActiveCell.Row).Value ioType = Range("B" & ActiveCell.Row).Value tagnavn = Range("C" & ActiveCell.Row).Value Register = Range("L" & ActiveCell.Row).Value test2 = Sheets("Innstillinger").Range("F9").Value If Register = "registrert" Then MsgBox "Denne er allerede registrert", vbExclamation, "kritisk feil" Unload Me ActiveCell.Offset(1, 0).Select Do Until ActiveCell.EntireRow.Hidden = False ActiveCell.Offset(1, 0).Select Loop Tagimport.Show End End If 'Autofullfør Prefix og Suffix til tag Dim sCellVal As String sCellVal = Range("A" & ActiveCell.Row).Value If sCellVal Like "*Tgr10*" Or _ sCellVal Like "*Tgr15*" Or _ sCellVal Like "*Tgr17*" Or _ sCellVal Like "*Tgr37*" Or _ sCellVal Like "*Tgr40x*" Or _ sCellVal Like "*Tgr70x*" Or _ sCellVal Like "*Tgr85*" Or _ sCellVal Like "*Tgr90*" Or _ sCellVal Like "*Tgr91*" Or _ sCellVal Like "*Tgr100*" Or _ sCellVal Like "*Tgr104*" Or _ sCellVal Like "*Tgr105*" Or _ sCellVal Like "*Tgr110*" Or _ sCellVal Like "*Tgr115*" Or _ sCellVal Like "*Tgr118*" Or _ sCellVal Like "*Tgr120x*" Or _ sCellVal Like "*Tgr128x*" Or _ sCellVal Like "*Tgr135*" Or _ sCellVal Like "*Tgr176*" Or _ sCellVal Like "*Tgr180x*" Or _ sCellVal Like "*TgrROx*" Or _ sCellVal Like "*Past1*" Or _ sCellVal Like "*Past3*" Or _ sCellVal Like "*Past4x*" Or _ sCellVal Like "*Past5*" Then tag_opc.Value = Sheets("Innstillinger").Range("F6") & Range("A" & ActiveCell.Row).Value & ".Value" 'String henta ifrå innstillinger F6 ElseIf sCellVal Like "*Past6x*" Or _ sCellVal Like "*Past7*" Or _ sCellVal Like "*Past904*" Or _ sCellVal Like "*MMS*" Or _ sCellVal Like "*Servicex*" Or _ sCellVal Like "*Tgr900*" Or _ sCellVal Like "*Tgr910*" Or _ sCellVal Like "*Tgr915*" Or _ sCellVal Like "*Tgr920*" Or _ sCellVal Like "*L952LIS*" Or _ sCellVal Like "*L952M2*" Or _ sCellVal Like "*T172BTU1*" Or _ sCellVal Like "*T172BFT1*" Or _ sCellVal Like "*T172Bph1*" Or _ sCellVal Like "*T172BTT1*" Or _ sCellVal Like "*Myse*" Or _ sCellVal Like "*Motorhead*" Then tag_opc.Value = Sheets("Innstillinger").Range("G6") & Range("A" & ActiveCell.Row).Value & ".Value" 'String henta ifrå innstillinger G6 ElseIf sCellVal Like "*Tgr170*" Or _ sCellVal Like "*Tgr171*" Or _ sCellVal Like "*Tgr173*" Then tag_opc.Value = Sheets("Innstillinger").Range("H6") & Range("A" & ActiveCell.Row).Value & ".Value" 'String henta ifrå innstillinger H6 ElseIf sCellVal Like "*Pasteur1*" Or _ sCellVal Like "*Pasteur2*" Or _ sCellVal Like "*Pasteur3*" Or _ sCellVal Like "*Pasteur4*" Or _ sCellVal Like "*Pasteur15*" Or _ sCellVal Like "*SmørSmelter*" Or _ sCellVal Like "*EksterneSystem*" Or _ sCellVal Like "*Trykk_Isvann*" Or _ sCellVal Like "*Trykk_Luft*" Or _ sCellVal Like "*Vannmåler*" Then tag_opc.Value = "OPC::Text3:" & Range("A" & ActiveCell.Row).Value & ".Value" ElseIf sCellVal Like "*Pasteur11*" Or _ sCellVal Like "*Pasteur12*" Or _ sCellVal Like "*Tgr65*" Or _ sCellVal Like "*Tgr70*" Or _ sCellVal Like "*Tgr75*" Or _ sCellVal Like "*Tgr145*" Or _ sCellVal Like "*Tgr166*" Or _ sCellVal Like "*Tgr180*" Or _ sCellVal Like "*Tgr211*" Or _ sCellVal Like "*Tgr244*" Or _ sCellVal Like "*TgrRO*" Or _ sCellVal Like "*Inndamper*" Or _ sCellVal Like "*T167*" Or _ sCellVal Like "*Nivå_BT_Tapp2*" Or _ sCellVal Like "FilterElveVannFeil*" Then tag_opc.Value = "OPC::Text4:" & Range("A" & ActiveCell.Row).Value & ".Value" ElseIf sCellVal Like "*Tgr20*" Or _ sCellVal Like "*Tgr25*" Or _ sCellVal Like "*Tgr28*" Or _ sCellVal Like "*Tgr150*" Then tag_opc.Value = "OPC::Text5:" & Range("A" & ActiveCell.Row).Value & ".Value" Else MsgBox "Finner ingen plassering" 'Kan ikkje plassere i program End If ' Next cell 'fyll inn dropdownliste engineering unit With unit .AddItem "g/cm3" .AddItem "µS/cm" .AddItem "liter" .AddItem "%" .AddItem "m³/t" .AddItem "l/t" .AddItem "°C" .AddItem "mBar" .AddItem "Bar" .AddItem "Ph" .AddItem "ms" .AddItem "m³" End With 'Sjekker om det er analog eller digital logging If ioType = "AnalogSignalIn" Then Analog.Value = True ElseIf ioType = "analogsignalIn" Then Analog.Value = True ElseIf ioType = "analogsignalin" Then Analog.Value = True ElseIf ioType = "Analogsignalin" Then Analog.Value = True ElseIf ioType = "AnalogSignalOut" Then Analog.Value = True ElseIf ioType = "analogsignalout" Then Analog.Value = True ElseIf ioType = "AnalogSignalout" Then Analog.Value = True ElseIf ioType = "BooleanSignal" Then Digital.Value = True ElseIf ioType = "booleansignal" Then Digital.Value = True ElseIf ioType = "booleanSignal" Then Digital.Value = True Else MsgBox "Det må velges analog eller digitalt signal", vbExclamation, "kritisk feil" End If 'Sett markør i Tagnamn hvis denne er tom If tagnavn = "" Then tagnavn.SetFocus End If End Sub Private Sub Reg_Click() ' If tagnavn.Value = "" Then MsgBox "Denne har ingen TAG", vbExlamation, "dette går ikkje" tagnavn.SetFocus Exit Sub End If 'Aktiver data-arket 'Velge kor data skal plasserast, analog eller digital If Analog = True Then If unit.Value = "" Then MsgBox "Dette er ein analog verdi, vennligst velg ein måleenhet", vbExlamation, "dette går ikkje" unit.SetFocus Exit Sub End If Sheets(2).Activate Range("A3").EntireRow.Insert Active_Row = 3 'Fylle inn i kolonner Range("A" & Active_Row) = meierinr + "_" + tagnavn '(AnalogTag)TagName" Range("B" & Active_Row) = beskrivelse 'Description Range("C" & Active_Row) = Sheets("Innstillinger").Range("D9") 'IOServerComputerName Range("D" & Active_Row) = Sheets("Innstillinger").Range("D10") 'IOServerAppName Range("E" & Active_Row) = Sheets("Innstillinger").Range("D11") 'TopicName Range("F" & Active_Row) = tag_opc.Value 'ItemName Range("G" & Active_Row) = Sheets("Innstillinger").Range("D12") 'AcquisitionType Range("H" & Active_Row) = Sheets("Innstillinger").Range("D13") 'StorageType Range("I" & Active_Row) = Sheets("Innstillinger").Range("D14") 'AcquisitionRate Range("J" & Active_Row) = Sheets("Innstillinger").Range("D14") 'StorageRate Range("K" & Active_Row) = Sheets("Innstillinger").Range("D15") 'TimeDeadband Range("L" & Active_Row) = Sheets("Innstillinger").Range("D16") 'SamplesInAI Range("M" & Active_Row) = Sheets("Innstillinger").Range("D17") 'AIMode Range("N" & Active_Row) = Sheets("Innstillinger").Range("D18") 'EngUnits Range("O" & Active_Row) = min 'MinEU Range("P" & Active_Row) = max 'MaxEU Range("Q" & Active_Row) = Sheets("Innstillinger").Range("D19") 'MinRaw Range("R" & Active_Row) = Sheets("Innstillinger").Range("D20") 'MaxRaw Range("S" & Active_Row) = Sheets("Innstillinger").Range("D21") 'Scaling Range("T" & Active_Row) = Sheets("Innstillinger").Range("D22") 'RawType Range("U" & Active_Row) = Sheets("Innstillinger").Range("D23") 'IntegerSize Range("V" & Active_Row) = Sheets("Innstillinger").Range("D24") 'Sign Range("W" & Active_Row) = Sheets("Innstillinger").Range("D25") 'ValueDeadband Range("X" & Active_Row) = Sheets("Innstillinger").Range("D26") 'InitialValue Range("Y" & Active_Row) = Sheets("Innstillinger").Range("D27") 'CurrentEditor Range("Z" & Active_Row) = Sheets("Innstillinger").Range("D28") 'RateDeadband Range("AA" & Active_Row) = Sheets("Innstillinger").Range("D29") 'InterpolationType Range("AB" & Active_Row) = Sheets("Innstillinger").Range("D30") 'RolloverValue Range("AC" & Active_Row) = Sheets("Innstillinger").Range("D31") 'ServerTimeStamp Range("AD" & Active_Row) = Sheets("Innstillinger").Range("D32") 'DeadbandType Range("AE" & Active_Row) = Sheets("Innstillinger").Range("D33") 'TagId Range("AF" & Active_Row) = Sheets("Innstillinger").Range("D34") 'ChannelStatus Range("AG" & Active_Row) = Sheets("Innstillinger").Range("D35") 'AITag Range("AH" & Active_Row) = Sheets("Innstillinger").Range("D36") 'AIHistory ElseIf Digital = True Then Sheets(2).Activate Active_Row = Range("A" & Rows.Count).End(xlUp).Row + 1 'Fylle inn i kolonner Range("A" & Active_Row) = meierinr + "_" + tagnavn ':(DiscreteTag)TagName Range("B" & Active_Row) = beskrivelse 'Description Range("C" & Active_Row) = Sheets("Innstillinger").Range("D9") 'IOServerComputerName Range("D" & Active_Row) = Sheets("Innstillinger").Range("D10") 'IOServerAppName Range("E" & Active_Row) = Sheets("Innstillinger").Range("D11") 'TopicName Range("F" & Active_Row) = tag_opc.Value 'ItemName Range("G" & Active_Row) = Sheets("Innstillinger").Range("D12") 'AcquisitionType Range("H" & Active_Row) = Sheets("Innstillinger").Range("D13") 'StorageType Range("I" & Active_Row) = Sheets("Innstillinger").Range("D14") 'AcquisitionRate Range("J" & Active_Row) = Sheets("Innstillinger").Range("D15") 'TimeDeadband Range("K" & Active_Row) = Sheets("Innstillinger").Range("D16") 'SamplesInAI Range("L" & Active_Row) = Sheets("Innstillinger").Range("D17") 'AIMode Range("M" & Active_Row) = "0" 'Message0 Range("N" & Active_Row) = "1" 'Message1 Range("O" & Active_Row) = Sheets("Innstillinger").Range("D26") 'InitialValue Range("P" & Active_Row) = Sheets("Innstillinger").Range("D27") 'CurrentEditor Range("Q" & Active_Row) = Sheets("Innstillinger").Range("D31") 'ServerTimeStamp Range("R" & Active_Row) = Sheets("Innstillinger").Range("D33") 'TagId Range("S" & Active_Row) = Sheets("Innstillinger").Range("D34") 'ChannelStatus Range("T" & Active_Row) = Sheets("Innstillinger").Range("D35") 'AITag Range("U" & Active_Row) = Sheets("Innstillinger").Range("D36") 'AIHistory Else MsgBox "Her har du ikkje følgt med, det må velges analogt eller digitalt signal!!!", vbExclamation, "GAPELESTE" Analog.SetFocus End End If Sheets(1).Activate 'ActiveCell.Markere Tag som registrert. Range("L" & ActiveCell.Row) = "registrert" 'oppdaterer regnearket ActiveWorkbook.RefreshAll ActiveCell.Offset(1, 0).Select Do Until ActiveCell.EntireRow.Hidden = False ActiveCell.Offset(1, 0).Select Loop Unload Me Tagimport.Show End Sub Private Sub Neste_Click() Unload Me ActiveCell.Offset(1, 0).Select Do Until ActiveCell.EntireRow.Hidden = False ActiveCell.Offset(1, 0).Select Loop Tagimport.Show End Sub Private Sub Avbryt_Click() Unload Me End Sub
我想得到我列出不同文本的部分，以便在表单上进行search，而不是在代码中进行search。
前面是这样的：IO.Tgr10.F182PT1应该是这样的：OPC :: Text2：IO.Tgr10.F182PT1.Value
如果之前是这样的：IO.Tgr150.F152PT1应该是这样的：OPC :: Text5：IO.Tgr150.F152PT1.Value