ここから本文です

EXCELでVBAを使って、特定の文字が入っているセルとセルの範囲を 指定したいです...

hel********さん

2019/5/1308:38:06

EXCELでVBAを使って、特定の文字が入っているセルとセルの範囲を
指定したいです。

例えば、セルには数式が入っていて、▽や▼が入ります。

1行には、▽が0~2まで、▼が0~2まで入るパターンがあります。
▽が2つ、または▼が2つ入っている場合は、▽と▽、または▼と▼が
入っているセルを選択したいです。

データが入っている最後の行まで、選択したセルに横線を引きたいのですが、
うまくいきません。

下記のコードは、セルの範囲を指定して、マクロを動かせば、思った通りの
横線が引けています。

これから、発展させることが出来ずにいます。

お知恵を貸していただけると助かります。

よろしくお願いいたします。



Sub 横線() '選択した範囲に線を引きます
Dim R As Range
Set R = Selection
With ActiveSheet.Shapes.AddLine(R.Left + 10, R.Top + R.Height / 3, R.Left + R.Width - 10, R.Top + R.Height / 3).LINE
.ForeColor.RGB = RGB(0, 0, 0)
.Style = 1
.BeginArrowheadStyle = 1
.EndArrowheadStyle = 1
.Weight = 1
End With
End Sub

閲覧数:
104
回答数:
1
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

mek********さん

2019/5/1706:03:34

下記のようなコ-ドでは?

ただし、
▽や▼があるセルを
両端に含んで、線を引くか、
含まないで、線を引くか、
によって多少見栄えが変わるかもしれません。
ご質問者がご提示のコ-ドですと、
両端に含んで、線を引いているので、
下記コ-ドも、それに合わせていますが、
※印のコメント部分の記述に変更すれば、
両端に含まない線となります。




Option Explicit


Sub LineADTest()
Dim St As Integer, Ed As Integer
Dim SX As Single, SY As Single
Dim EX As Single, EY As Single
Dim i As Long, j As Integer
Dim Flag As Boolean
Dim StartRow As Long, StartColumn As Integer
Dim Max_Row As Long, Max_Column As Integer
Dim UsedCell As Range
Dim UsedArea As String

Set UsedCell = ActiveSheet.UsedRange

With UsedCell
UsedArea = .Address
StartRow = .Cells(1).Row
StartColumn = .Cells(1).Column

Max_Row = .Cells(.Count).Row
' Max_Row =.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
Max_Column = .Cells(.Count).Column
' Max_Column = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With


Application.ScreenUpdating = False

For i = StartRow To Max_Row
Flag = False
St = 0: Ed = 0
For j = StartColumn To Max_Column

If Flag = False And (Cells(i, j) = "▽" Or Cells(i, j) = "▼") Then
St = j ' ※ あるいは、 j + 1
Flag = True
ElseIf Flag = True And (Cells(i, j) = "▽" Or Cells(i, j) = "▼") Then
Ed = j ' ※ あるいは、 j - 1
Flag = False
End If

If St > 0 And Ed > 0 Then
SX = Cells(i, St).Left + 10
SY = Cells(i, St).Top + Cells(i, St).Height / 3
EX = Cells(i, Ed).Left + Cells(i, Ed).Width - 10
EY = Cells(i, Ed).Top + Cells(i, Ed).Height / 3

With ActiveSheet.Shapes.AddLine(SX, SY, EX, EY).Line
.ForeColor.RGB = vbBlack ' 赤なら_ vbRed
.Style = 1
.Weight = 1
.BeginArrowheadStyle = 1
.EndArrowheadStyle = 1
End With
St = 0: Ed = 0
End If

Next

Next

Application.ScreenUpdating = True

Set UsedCell = Nothing

End Sub

  • mek********さん

    2019/5/1708:29:28

    蛇足ながら、
    ▽と▽、または▼と▼の
    両端のセルで、
    ▽または▼を含むセル範囲で、
    線を引くという場合、

    .BeginArrowheadStyle = 1
    .EndArrowheadStyle = 1

    の部分を

    .BeginArrowheadStyle = 3
    .EndArrowheadStyle = 3

    のようにしますと、
    線の両端に矢印がつきますので、
    より範囲が明確化することもあります。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この回答は投票によってベストアンサーに選ばれました!

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる