2016-12-17 126 views
1

我有一个超过1000行的表。在列AI F列有像如何检查一个值是否包含特定文本

:IO.Tgr37.Tank37.TT 

在片“innstiilinger”一文中,我有一堆关键字来查找, 像Tgr37上ROW7和Tgr10上ROW8

在列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

回答

0

你在哪里声明tag_opc对象?

无论如何,.Find方法是用于此类操作的糟糕选择。执行你正在做的事情的最有效方法是将数据提升到一个数组(或数组)中,处理你需要处理的内容,然后将结果转换回他们需要去的地方。然而,为了使事情变得容易一些,我会建议一个选项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中的任何内容都是非常挑剔的。例如,您可以使用循环在每次迭代中向上递增i值。尽管如此,它对你想要做的事情有点含糊不清。您多次提及“文本”,但不要说明您指的是哪个“文本”。

你能提供Before and After的例子吗?如果我们能够明确地看到你想要做什么,我们可能会提供更好的答案。

+0

我所指的文字是来自PLC程序的opc标签。我将把标签导入历史记录软件,但标签不完整。我需要为标签添加一些额外的文本,我需要添加的文本取决于它属于的“Tgrxx”。所以我想列出需要“color1”添加到coloum F中的opc-tag(这是大约10个不同的Tgr)的不同Tgr,并且需要添加“text2”的Tgr列在Coloum G ....等等中。 。 –

0

今天我尝试了各种各样的把戏,我很接近,但没有...我已经删除了所有,并开始回来。这是我的代码:

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 

我想得到的部分在哪里列出不同的文本在表单上搜索出来,而不是在代码中。

的面前是这样的:IO.Tgr10.F182PT1 后应该是这样的:OPC ::文本2:IO.Tgr10.F182PT1.Value

如果说之前是这样的:IO.Tgr150.F152PT1 之后应该是这样的:OPC :: Text5:IO.Tgr150.F152PT1。值

相关问题