2016-12-17 7 views
1

У меня есть лист с более чем 1000 строк. В колонке AI есть текст, какКак проверить, имеет ли значение определенный текст в нем

:IO.Tgr37.Tank37.TT 

В листе «innstiilinger» в колонке F, у меня есть куча ключевых слов для поиска, как 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 

, но не работает, когда я положил ключевое слово в колонке А и текст в столбце 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 на более конкретную ссылку, так как ничего active в VBA, по-видимому, искусно. Вы можете использовать цикл, например, для увеличения значения i вверх через каждую итерацию.

Его немного двусмысленно относительно того, что вы хотите здесь сделать. Вы ссылаетесь на «текст» несколько раз, но не уточняете, какой «текст» вы имеете в виду.

Можете ли вы предоставить примеры до и после? Вероятно, мы сможем дать лучший ответ, если мы увидим, что именно вы хотите сделать.

+0

Текст, на который я ссылаюсь, это теги opc из программы plc. Я собираюсь импортировать теги в программное обеспечение для архиватора, но теги не заполнены. Мне нужно добавить дополнительный текст к тегам, и какой текст мне нужно добавить, зависит от того, к чему принадлежит «Tgrxx». Так что мне нужен список разных Tgr, которые нуждаются в «text1», добавленном в opc-тег в coloum F (это около 10 различных Tgr), а Tgr, которые нужно добавить «text2», перечислены в 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.Значение

Смежные вопросы