VBA OR条件での検索について教えてください。

質問

VBA初心者です。また質問させてください。
以前、下記のような表で、『小計』の文字を検索して行を挿入したり、斜め線を引くという内容をVBAでやる方法を教えていただきました。
その節はありがとうございました。
*************************************************************　　　A　　　　B　　　　　　　C　　　　D
1　
2　　項目　品名　　　　　　　数量　　　単位
3　　　　　内訳（別紙明細）　1　　　　 式
4　　　　　ブレーカ　　　　　　1　　　　 ヶ
5　　　　　消耗品　　　　　　　1　　　　 式　　
6　　　　　　　　　　　　
7
8　　　　　　　　　　　小計
*************************************************************
今度は『小計』だけでなく『合計』があった場合も、同じ処理をするVBAを作成したいのですがうまくいきません。
以下が記述です。
*************************************************************
Private Sub 斜め線描画_Click()

Dim myLine As Shape
Dim c As Range
Dim cnt As Integer
Dim i As Integer

cnt = WorksheetFunction.CountIf(Cells, "*小　　　計*")

Set c = Cells.Find(What:="小　　　計", LookIn:=xlFormulas, LookAt:=xlPart)
If Not c Is Nothing Then
i = 1
Call LineArranging(c)
Do
If i >= cnt Then Exit Sub 'カウントでチェック
Set c = Cells.FindNext(c)
If c Is Nothing Then Exit Sub
Call LineArranging(c)
i = i + 1
Loop
End If

Set c = Nothing
End Sub
Sub LineArranging(rng As Range)

Dim BX As Double, BY As Double, EX As Double, EY As Double
Dim rngStart As Range, rngEnd As Range
Dim myLine As Shape

rng.Select
ActiveCell.Rows("1:2").EntireRow.Select
Selection.Insert Shift:=xlDown
rng.Offset(1, 0).Select
ActiveCell.Rows("1:2").EntireRow.Select
Selection.Insert Shift:=xlDown
rng.Offset(-2, 0).Select
Selection.EntireRow.Insert
ActiveCell.EntireRow.Select
Selection.RowHeight = 2
rng.Offset(1, 0).Select
Selection.EntireRow.Insert
ActiveCell.EntireRow.Select
Selection.RowHeight = 2

Set rngStart = rng.Offset(1, -1)
Set rngEnd = rng.Offset(-2, 0)

BX = rngStart.Left
BY = rngStart.Top
EX = rngEnd.Left + rngEnd.Width
EY = rngEnd.Top

Set myLine = Sheet4.Shapes.AddLine(BX, BY, EX, EY)
BX = BX + 151.5
BY = BY - 27
EX = EX - 152.25
EY = EY + 26.25
Set myLine = Sheet4.Shapes.AddLine(BX, BY, EX, EY)

Set rngStart = Nothing
Set rngEnd = Nothing
Set myLine = Nothing
End Sub
*************************************************************
『または』なのでorを使うのかと思ったのですが、エラーになりうまくいきません。どうしたらいいのか教えてください。
よろしくお願いします。

回答No.1

zap35 · ベストアンサー

以前のマクロは読んでいませんが"小　　　計"と"合　　　計"以外にも"中　　　計"とか"総　合　　計"など色々あり、小計と合計だけに処理をしたいということでなければ

　"　　　計"に対して検索をかける

という方法ではいけませんか？

または"小　　　計"で処理をした後で、もう一度"合　　　計"で同じ処理をかける方法もあると思います。（FindメソッドでOr条件はできないと思います）

お礼

ありがとうございます！
目から鱗でした(^^ゞ

"*　　計"にしたらうまく動きました。

回答No.2

Wendy02

こんばんは。

>今度は『小計』だけでなく『合計』があった場合も、同じ処理をするVBAを作成したいのですがうまくいきません。

なぜ、サブルーチンにしたか、その意味を考えてみてください。2箇所変えるだけです。私の前回のコードを変え、ここまで自力で書いたのですから、テクニックの問題は別として、なんとなく、解答はご自身で分かるはずです。もう、「VBA初心者です。」ではありませんね。

ただ、ここまで書いていらっしゃるので、少し掘り下げて注意点を書いておくと、オートシェイプのラインには、何百回も同じシートで書いたり消したりしていると、調子が悪くなり見えなくなることがあるようですから、二度手間のようですが、Line のVisible プロパティを、True にしたり、色を明示的に、黒を付けたりしたほうが良いようです。もしかしたら、ハードの問題なのかもしれません。この件は、ここのカテゴリでも質問が出ていました。同じシートである限りは、解決の目処を知りません。自分のものだけならよいのですが、他人に使わせることになって、何度か、私は、失敗しています。

Private Sub 斜め線描画_Click()

　　Dim myLine As Shape
　　Dim c As Range
　　Dim cnt As Integer
　　Dim i As Integer
　　Dim v As Variant　'v は、Value のv

　　For Each v In Array("小　　　計", "合　　　計") '加筆*

　　　　cnt = WorksheetFunction.CountIf(Cells, "*" & v & "*")
　　　　If cnt > 0 Then

　　　　　　Set c = Cells.Find(What:=v, LookIn:=xlFormulas, LookAt:=xlPart)
　　　　　　If Not c Is Nothing Then
　　　　　　　　i = 1
　　　　　　　　Call LineArranging(c)
　　　　　　　　Do
　　　　　　　　If i >= cnt Then Exit Do 'カウントでチェック 加筆*
　　　　　　　　　　Set c = Cells.FindNext(c)
　　　　　　　　　　If c Is Nothing Then Exit Sub
　　　　　　　　　　Call LineArranging(c)
　　　　　　　　　　i = i + 1
　　　　　　　　Loop
　　　　　　End If
　　　　End If
　　Next v
　　Set c = Nothing
End Sub

後は、同じです。

なお、#1さんの注意点は、ごもっともです。
> "　　　計"に対して検索をかける
という文字列のほうが良いかもしれません。

お礼

Wendy02さん、前回も大変お世話になりました。本当に助かりました！
解決策としては、#1さんのおっしゃる通りにやってみました。

>オートシェイプのラインには、何百回も同じシートで書いたり消したりしていると、調子が悪くなり見えなくなることがあるようですから、二度手間のようですが、Line のVisible プロパティを、True にしたり、色を明示的に、黒を付けたりしたほうが良いようです。

ネット上の情報をCSVで落として（ローカルにある）EXCELのファイルに出力しその後でマクロで上記のように処理するので、多分何百回、何千回と処理をすることになると思うので、ご意見、大変参考になりました。早速検討したいと思います。