2016-12-17 21 views
1

私は1000行以上のシートを持っています。コラムでAIが列Fに「innstiilinger」シートで値に特定のテキストがあるかどうかを確認する方法

:IO.Tgr37.Tank37.TT 

のようなテキストを持って、私は列のGIでrow8

にrow7とTgr10にTgr37のように、ために を持って見てキーワードの束を持っています

Tgr 120, Tgr 600....... 

テキストにTgr37またはTgr10が含まれている場合は、プレフィックスをテキストに追加します。 テキストはそれにTgr120またはTgr600を持っている場合、私はテキストに別の接頭辞を追加します。..

私はこのコードを試してみました:私は、列Aに私のキーワードを入れると、

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 

をしかし、それは動作しません。シート "innstillinger"の列Fのテキストが機能します。あなたがtag_opcオブジェクトを宣言している

私の悪い英語のため申し訳ありません

が、私はあなたが私の問題を理解してほしい... エクセル2013

答えて

0

とにかく、このような操作には.Findメソッドを使用するのが不適切です。あなたがやっていることを実行する最も効率的な方法は、データを配列(または配列)に持ち上げて処理する必要があるものを処理し、結果を必要な場所に転記することです。

少しでも簡単にするには、代わりに質問の範囲にFor Eachループを使用するオプションBをお勧めします。

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 

これは、実行する必要があるコアです。しかし、VBAのactiveは何かがひどく厄介なので、より具体的な参照のためにActiveCellを交換します。たとえば、ループを使用して、反復ごとにiの値を上方向に増加させることができます。

あなたがここでやりたいことは少し曖昧です。 「テキスト」を複数回参照しますが、参照している「テキスト」を明確にしないでください。

前と後の例を提供できますか?あなたが探しているものを具体的に見ることができれば、より良い答えを提供できるようになるでしょう。

+0

私が参照しているテキストは、plcプログラムのopcタグです。タグをhistoryloggerソフトウェアにインポートしようとしていますが、タグは完全ではありません。タグに余分なテキストを追加する必要があります。追加する必要のあるテキストは、それが属する「Tgrxx」に依存します。だから私は、 "text1"をcoloum F(これは約10種類のTgr)のopcタグに追加する必要がある別の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 

私は、シート上ではなく、コード内で検索する別のテキストをリストアップしている部分を取得したいと思います。 OPC ::テキスト2:IO.Tgr150.F152PT1 :IO.Tgr10.F182PT1.Value

前であれば、このようなものです。このようにする必要があります後IO.Tgr10.F182PT1 :

前に、このようなものです後はOPC :: Text5:IO.Tgr150.F152PT1のようになります。値

関連する問題