2016-12-17 128 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。值

相關問題