web-dev-qa-db-ja.com

VBAを使用してセル内の文字列を検索する

私はこれで1日間気を狂わせて運転し、高低を検索しました。おそらく、可愛すぎて、完全に行き詰まっています。

その場合、私はシンプルを実行しようとしています

セルに「％」が含まれている場合、あることを行い、そうでない場合は別のことを行います。理由がわからないので、うまく動かせません。私は他の場所からいくつかのアイデアをはっきりと取り入れましたが、それでもそれを機能させることはできません。

複雑な要因-テーブル全体でこれを実行したくないので、ロットまたは相対ActiveCellを使用してより大きなサブに埋め込まれます。 A列のどこで「％変更」に遭遇するかわからないので、範囲は常に変数でなければなりません。 VBA/VBEに「％」が含まれているセルに到達したときに別の処理を実行したい。そう

生データは次のようになります

Initial Value (6/30/06)

Value (12/31/06)

Net Additions (9/30/07)

Withdrawal (12/07)

Value (12/31/07)

Withdrawal (2008)

Value (12/31/08)

Addition (8/26/09)

Value (12/31/09)

Value (12/31/10)

Value (12/30/11)

Value (3/31/12)

% Change 1st Quarter

% Change Since Inception

しかし、次のコードを実行すると、サブルーチンの「Else」部分とは対照的に、「If Then」に引き込まれているはずの悪いループに陥ります。

Sub IfTest()
 'This should split the information in a table up into cells
 Dim Splitter() As String
 Dim LenValue As Integer     'Gives the number of characters in date string
 Dim LeftValue As Integer    'One less than the LenValue to drop the ")"
 Dim rng As Range, cell As Range
 Set rng = ActiveCell

Do While ActiveCell.Value <> Empty
    If InStr(rng, "%") = True Then
        ActiveCell.Offset(0, 0).Select
        Splitter = Split(ActiveCell.Value, "% Change")
        ActiveCell.Offset(0, 10).Select
        ActiveCell.Value = Splitter(1)
        ActiveCell.Offset(0, -1).Select
        ActiveCell.Value = "% Change"
        ActiveCell.Offset(1, -9).Select
    Else
        ActiveCell.Offset(0, 0).Select
        Splitter = Split(ActiveCell.Value, "(")
        ActiveCell.Offset(0, 9).Select
        ActiveCell.Value = Splitter(0)
        ActiveCell.Offset(0, 1).Select
        LenValue = Len(Splitter(1))
        LeftValue = LenValue - 1
        ActiveCell.Value = Left(Splitter(1), LeftValue)
        ActiveCell.Offset(1, -10).Select
    End If
Loop
End Sub

すべての助けに感謝します、ありがとう！

stringexcelsearchexcel-vbavba
6
Tommy Z

セル内にある「％」のテストを分離するようにコードを簡略化しました。それが機能するようになったら、残りのコードを追加できます。

これを試して：

Option Explicit


Sub DoIHavePercentSymbol()
   Dim rng As Range

   Set rng = ActiveCell

   Do While rng.Value <> Empty
        If InStr(rng.Value, "%") = 0 Then
            MsgBox "I know nothing about percentages!"
            Set rng = rng.Offset(1)
            rng.Select
        Else
            MsgBox "I contain a % symbol!"
            Set rng = rng.Offset(1)
            rng.Select
        End If
   Loop

End Sub

InStrは、検索テキストが文字列に出現する回数を返します。 ifテストを変更して、最初に一致するものがないかどうかを確認しました。

メッセージボックスと.Selectsコードをステップ実行しているときに何が起こっているのかを簡単に確認できる場所があります。動作させたら取り出してください。

5
Jon Crowell

検索ルーチンについては、Find、AutoFilterまたはバリアント配列アプローチを使用することを検討する必要があります。範囲ループは通常は遅すぎますが、Selectを使用するとさらに悪くなります

以下のコードは、ユーザーが選択した範囲でstrText変数を探し、一致を範囲変数rng2に追加します。これをさらに処理できます。

Option Explicit

Const strText As String = "%"

Sub ColSearch_DelRows()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim strFirstAddress As String
    Dim lAppCalc As Long


    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search for " & strText, "User range selection", Selection.Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub

    With Application
        lAppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)

    'A range variable - rng2 - is used to store the range of cells that contain the string being searched for
    If Not cel1 Is Nothing Then
        Set rng2 = cel1
        strFirstAddress = cel1.Address
        Do
            Set cel1 = rng1.FindNext(cel1)
            Set rng2 = Union(rng2, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    If Not rng2 Is Nothing Then
        For Each cel2 In rng2
            Debug.Print cel2.Address & " contained " & strText
        Next
    Else
        MsgBox "No " & strText
    End If

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With

End Sub
0
brettdj

rngの値は変更しないので、常に初期セルを指します

ループの前にSet rng = rng.Offset(1, 0)を新しい行にコピーします

また、InStrテストは常に失敗します
Trueは-1ですが、文字列が見つかった場合、InStrからの戻り値は0より大きくなります。テストを削除するように変更= True

新しいコード：

Sub IfTest()
 'This should split the information in a table up into cells
 Dim Splitter() As String
 Dim LenValue As Integer     'Gives the number of characters in date string
 Dim LeftValue As Integer    'One less than the LenValue to drop the ")"
 Dim rng As Range, cell As Range
 Set rng = ActiveCell

Do While ActiveCell.Value <> Empty
    If InStr(rng, "%") Then
        ActiveCell.Offset(0, 0).Select
        Splitter = Split(ActiveCell.Value, "% Change")
        ActiveCell.Offset(0, 10).Select
        ActiveCell.Value = Splitter(1)
        ActiveCell.Offset(0, -1).Select
        ActiveCell.Value = "% Change"
        ActiveCell.Offset(1, -9).Select
    Else
        ActiveCell.Offset(0, 0).Select
        Splitter = Split(ActiveCell.Value, "(")
        ActiveCell.Offset(0, 9).Select
        ActiveCell.Value = Splitter(0)
        ActiveCell.Offset(0, 1).Select
        LenValue = Len(Splitter(1))
        LeftValue = LenValue - 1
        ActiveCell.Value = Left(Splitter(1), LeftValue)
        ActiveCell.Offset(1, -10).Select
    End If
Set rng = rng.Offset(1, 0)
Loop

End Sub
0
SeanC