Question

我有一张超过1000行的表格。在A栏中，我有一个像

这样的文字

:IO.Tgr37.Tank37.TT

在F栏的单曲“innstiilinger”中，我有一堆关键词要查找，比如第7行的Tgr37和第8行的Tgr10

在G栏中我有

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列中，并且在“innstillinger”表格中的F列中的文字时，它可以正常工作。

抱歉我的英语不好但我希望你能理解我的问题...... Excel 2013

Answer 1

你在哪里声明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中的任何active都是非常挑剔的。例如，您可以使用循环在每次迭代中向上递增i值。

但是，对于你想在这里做什么，它有点模棱两可。你引用＆＃34; text＆＃34;多次，但不要澄清哪些＆＃34;文本＆＃34;你指的是。

您能提供前后示例吗？如果我们能够具体了解您的目标，我们可能会提供更好的答案。

Answer 2

我今天尝试了各种各样的技巧，我很接近，但没有...我已经删除了所有并重新开始。这是我的代码：

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 :: Text2：IO.Tgr10.F182PT1.Value

如果之前是这样的：IO.Tgr150.F152PT1 之后应该是这样的：OPC :: Text5：IO.Tgr150.F152PT1.Value

如何检查值中是否包含特定文本

2 个答案: