excel VBAについての質問です

質問

はじめまして。

A列に、特定の文字列を含むセルがあった場合にその右下のセルを選択するにはどうしたらいいでしょうか？

　例えば、セル（A5）に「エクセル」という文字列があった場合に、セル（B6)を選択したいのです。また、そしてA列には「エクセル」を含むセルがいくつかあり、それらセルについてもそれぞれの右下のセルを選択させたいのですが・・・。

回答No.6

zap35 · ベストアンサー

＃０３です。補足要求には回答いただけないようですね
とりあえず＃０１さんの補足をみてVBAを修正しました
アクティブなシートのA列の「エクセル」を含むセルの右下のセル（複数ありえる）をSheet2のA1セルを起点に貼り付けるようにしました

Sub Macro2()
Dim adrs As String
Dim idx As Long
For idx = 1 To Range("A65536").End(xlUp).Row
　　If InStr(Cells(idx, "A").Value, "エクセル") > 0 Then
　　　　adrs = adrs & Cells(idx, "A").Address & ","
　　End If
Next idx
If Len(adrs) > 0 Then
　　Range(Left(adrs, Len(adrs) - 1)).Offset(1, 1).Copy _
　　　　　Destination:=Sheets("Sheet2").Range("A1")
End If
End Sub

補足

上のマクロを使うと、うまくいきました。ありがとうございます。

ただ、もうひとつ。選択したセルはそれぞれ"00001111商品名　単位・・・）などと長い文字列なのですが、その中で00001111の部分だけ抜き取って貼り付けするようにはできるのでしょうか？

初心者で申し訳ありません。皆さんの知識には感服します。

回答No.5

Wendy02

こんばんは。

>選択した後にコピーして別のシートに貼り付けしたかったんです。

Sub TestMarco1()
　　Dim r As Range
　　Dim c As Range
　　Dim i As Long
　　Dim PasteRng
　　'検索語
　　Const SWORD As String = "エクセル"
　　'ペースト先-先頭セル
　　Set PasteRng = Worksheets("Sheet2").Range("A1")
　　With ActiveSheet
　　If .AutoFilterMode Then
　　　　.AutoFilterMode = False
　　End If

　　On Error GoTo ErrHandler
　　With .Range("A1").CurrentRegion.Columns(1)
　　　　.AutoFilter Field:=1, Criteria1:=SWORD
　　　　Set r = .Offset(1).Resize(.Rows.Count - 1). _
　　　　　　 SpecialCells(xlCellTypeVisible)
　　　　.AutoFilter
　　End With
　　i = 1

　　If .Range("A1").Value = SWORD Then
　　　.Range("A1").Offset(1, 1).Copy PasteRng.Cells(i, 1)
　　　i = i + 1
　　End If
　　For Each c In r.Cells
　　　　c.Offset(1, 1).Copy PasteRng.Cells(i, 1)
　　　　i = i + 1
　　Next c
ErrHandler:
　　If Err.Number > 0 Then
　　　 .AutoFilterMode = False
　　　 MsgBox SWORD & " は見つかりません"
　　End If
　　End With
　　Set r = Nothing
　　Set PasteRng = Nothing
End Sub

回答No.4

imogasi

＞についてもそれぞれの右下のセルを選択させたいのですが・・・。
選択して何もしないで次ぎに行っても何にもならないが、処理の説明を省略したの？
Ｆｉｎｄメソッドでやる場合もあるが、初心者には難しい。
それでＭＡＴＣＨ関数でやってみたが、やはり難しい。参考までに。
Sub test05()
On Error GoTo ext1
d = Range("A65536").End(xlUp).Row
s = 1
mg = 0
Do
Set x = Range("A" & s & ":A" & d)
g = Application.WorksheetFunction.Match("エクセル", x, 0)
mg = mg + g
Cells(mg, "A").Offset(1, 1).Select
MsgBox mg
s = mg + 1
If s > d Then GoTo ext1
Loop
ext1:
End Sub
ーー
全行ＩＦ文でエクセルか聞いていくのが、単純で良さそう。

回答No.3

zap35

補足要求です
１）特定の文字列を含むセル
部分一致の「エクセル」「マイクロソフトエクセル」「エクセル・ワード」のセルも対象ですか？　それとも完全一致のセルだけが対象ですか？

２）それらセルについてもそれぞれの右下のセルを選択させたい
仮に「エクセル」を含むセルが３つあったとします。その場合、同時に右下の３つのセルを同時に選択した状態にするのですか？　（それにはどんな意味があるのでしょうか？）

全ての部分一致セルの右下セルを同時に選択するならこんなマクロでもできますが…

Sub Macro2()
Dim adrs As String
Dim idx As Long
For idx = 1 To Range("A65536").End(xlUp).Row
　　If InStr(Cells(idx, "A").Value, "エクセル") > 0 Then
　　　　adrs = adrs & Cells(idx, "A").Address & ","
　　End If
Next idx
If Len(adrs) > 0 Then
　　Range(Left(adrs, Len(adrs) - 1)).Offset(1, 1).Select
End If
End Sub

補足

すみません。補足要求に回答いたします。
1)部分一致のセルも対象です。
2)同時に3つのセルを選択した状態にしたいです。

回答No.2

nekoron07

細かい条件がわからないのですが、とりあえず作ってみました。

※Ａ列には常にデータが入っているのでしょうか。それとも「エクセル」のほかは空白？　→　とりあえずＡ列には何かデータが入っているものとして、Ａ列に空白が出るまで作業を続けるようになってます。

※Ａ列に「エクセル」の文字列があったとき、その右下のセルに対してしたい処理は？　→　とりあえず「１」が入力されるようになっています。

Sub Macro()
　　Range("A1").Select
　　Do While ActiveCell <> ""
　　　If ActiveCell = "エクセル" Then
　　　　ActiveCell.Offset(1, 1).Range("A1").Select
　　　　ActiveCell = 1
　　　　ActiveCell.Offset(0, -1).Range("A1").Select
　　　Else
　　　　ActiveCell.Offset(1, 0).Range("A1").Select
　　　End If
　　Loop
End Sub

回答No.1

noname#123709

以下のような感じでもできます。
ただ、何の為の選択でしょうか？選択するだけの動作に意味があるのでしょうか？
Sub test()
Dim i As Long
Dim j As String
For i = 1 To Range("A65536").End(xlUp).Row
If Cells(i, 1).Value = "エクセル" Then
If j = Empty Then j = Cells(i + 1, 2).Address
j = j & "," & Cells(i + 1, 2).Address
End If
Next i
If j <> Empty Then Range(j).Select
End Sub

補足

＞ただ、何の為の選択でしょうか？選択するだけの動作に意味があるのでしょうか？

説明不足で申し訳ございません。選択した後にコピーして別のシートに貼り付けしたかったんです。