2

「すべての顧客」の値を持つシート内のすべてのセルを検索するマクロをExcel2010で作成しようとしています。その値が見つかるたびに、その下に空白行を挿入する必要があります。非常に簡単だと思いましたが、私は多くのフォーラムを検索し、いくつかのサンプルコードを使用しようとしましたが、正しく機能させることができません。VBAのことになると、私は完全な初心者です。ここに投稿して、VBAの基本について少し読んでみようと思いました。

誰かが良いトレーニングリソースを持っているなら、それらも投稿してください。

前もって感謝します！

編集：私のOPでは、「すべての顧客」の値を含む行は、理想的には強調表示され、太字の拡大されたサイズのフォントで配置されることに言及していませんでした。

これらのアクションは、古いCrystalReportの表示/フォーマットプログラムがレポートをプルするときに自動的に処理するために使用されていたものです。プログラムをアップグレードした後、ソフトウェアメーカーのテクニカルサポートによると、このタイプのフォーマット機能は、プログラムの新しいバージョンのリリースで削除されたことを知りました。これがリリースノートで定義されていたら、アップグレードは実行しなかったでしょう。とにかく、それは私がこのマクロ災害に自分自身を見つけた方法です。

4

5 に答える 5

1

ここにある私の記事から引用したこのコードのようなものは効率的であり、ループを回避します

  1. それは太字で、テキストが見つかるフォントサイズを大きくします（行全体で、Timが指摘しているように、セルのみを意味するかどうかを指定する必要があります）
  2. 一致の下に空白行を追加します

コード

Option Explicit

Const strText As String = "All Customers"

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
    Dim bParseString As Boolean

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

    'Further processing of matches
    bParseString = True

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

    'a) match string to entire cell, case insensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , False)

    'b) match string to entire cell, case sensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , True)

    'c)match string to part of cell, case insensititive
     Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)

    'd)match string to part of cell, case sensititive
    ' Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , True)

    '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.EntireRow, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    'Further processing of found range if required
    If bParseString Then
        If Not rng2 Is Nothing Then
        With rng2
        .Font.Bold = True
        .Font.Size = 20
        .Offset(1, 0).EntireRow.Insert
        End With
    End If
    End If

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

End Sub
于 2013-01-05T09:08:26.633 に答える
1

これが最初のシート (「シート 1」) にあると仮定すると、遅い答えは次のとおりです。

Sub InsertRowsBelowAllCustomers()

    'Set your worksheet to a variable
    Dim sheetOne as Worksheet 
    Set sheetOne = Worksheets("Sheet1")

    'Find the total number of used rows and columns in the sheet (where "All Customers" could be)
    Dim totalRows, totalCols as Integer
    totalRows = sheetOne.UsedRange.Rows.Count
    totalCols = sheetOne.UsedRange.Columns.Count

    'Loop through all used rows/columns and find your desired "All Customers"
    Dim row, col as Integer
    For row = 1 to totalRows
        For col = 1 to totalCols
            If sheetOne.Cells(row,col).Value = "All Customers" Then
                  Range(sheetOne.Cells(row,col)).Select
                  ActiveCell.Offset(1).EntireRow.Insert
                  totalRows = totalRows + 1 'increment totalRows because you added a new row
                  Exit For  
            End If 
        Next col
    Next row
End Sub
于 2013-01-03T23:22:09.173 に答える
1 
Public Sub InsertRowAfterCellFound()

    Dim foundRange As Range
    Set foundRange = Cells.Find(What:="yourStringOrVariant", After:=ActiveCell) 'Find the range with the occurance of the required variant

    Rows(foundRange.Row + 1 & ":" & foundRange.Row + 1).Insert 'Insert a new row below the row of the foundRange row

    foundRange.Activate 'Set the found range to be the ActiveCell, this is a quick and easy way of ensuring you aren't repeating find from the top

End Sub

指定した値のセルが見つからない場合はエラーが発生するため、コードにエラー処理を追加する必要がある場合があります。

于 2013-01-03T23:18:31.137 に答える
0

この関数は、最後の行から開始して最初の行に戻り、列 A の「すべての顧客」を含む各セルの後に空の行を挿入します。

Sub InsertRowsBelowAllCustomers()
  Dim R As Integer
  For R = UsedRange.Rows.Count To 1 Step -1
    If Cells(R, 1) = "All Customers" Then Rows(R + 1).Insert
  Next R
End Sub
于 2013-01-04T05:56:54.320 に答える