Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

287 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【76692】Re:セルの内容が変わったときの記述方法

gg56 - 15/2/27(金) 12:43 -


	引用なし

	パスワード

独覚さま、βさま
お二方共、私の間違った記載コードでも意図を汲み取っていただきました。
ありがとうございます。
For Each Nextを利用するのですね。
思いもよりませんでした。
精進いたします。

・ツリー全体表示


	【76691】Re:文字数の多い検索ワードから少ない文...

kanabun - 15/2/27(金) 11:55 -


	引用なし

	パスワード

▼さとちぃさん： >Sub 名刺情報からの拠点情報検索() >　　Dim kaisyamei As String >　　Set kaisyamei = "*" & ActiveCell & "*" ↑これだと、 ActiveCellの値が「ABC株式会社」だったとすると、文字列変数kaisyamei には「*ABC株式会社*」が入っていることになります。　　そのあとで、↓ActiveCellの値から"株式会社"Removeしても、、、 >　　'アクティブセルの値から株式会社の文字をなくす(置換) >　　ActiveCell.Replace What:="株式会社", Replacement:="", LookAt:=xlPart, _ >　　　　SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ >　　　　ReplaceFormat:=False 後の祭りです。イミディエイト・ウィンドウで ? kaisyamei とやって kaisyamei に何が入っているか、確認してみてください。 >　　'拠点情報に移動し、株式会社をなくしたワードで検索 >　　Worksheets("拠点情報").Select >　　ActiveSheet.Range("A10:A1000").AutoFilter Field:=1, Criteria1:=kaisyamei Replaceメソッドでなく Replace関数を使えばいいのでは？ Dim s as string s = ActiveCell.Value s = "*" & Replace(s, "株式会社", "") & "*" Worksheets("拠点情報").Range("A10:A1000").AutoFilter Field:=1, Criteria1:=s

・ツリー全体表示


	【76690】Re:文字数の多い検索ワードから少ない文...

さとちぃ - 15/2/27(金) 11:21 -


	引用なし

	パスワード

自分で以下のように考えてみました。

置換については、マクロのコピーにて確認しています。
実際これで検索してみましたが、うまくいきません・・・。

Sub 名刺情報からの拠点情報検索()
　　Dim kaisyamei As String
　　Set kaisyamei = "*" & ActiveCell & "*"
　　
　　'アクティブセルの値から株式会社の文字をなくす(置換)
　　ActiveCell.Replace What:="株式会社", Replacement:="", LookAt:=xlPart, _
　　　　SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
　　　　ReplaceFormat:=False
　　Cells.Find(What:="株式会社", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
　　　　:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
　　　　False, MatchByte:=False, SearchFormat:=False).Activate

　　'拠点情報に移動し、株式会社をなくしたワードで検索
　　Worksheets("拠点情報").Select
　　ActiveSheet.Range("A10:A1000").AutoFilter Field:=1, Criteria1:=kaisyamei
　　End Sub
　　

・ツリー全体表示


	【76689】Re:セルの内容が変わったときの記述方法

gg56 - 15/2/27(金) 10:26 -


	引用なし

	パスワード

すみません。
コードが間違っていました。

Private Sub Worksheet_change(ByVal Target As Range)
　If Target.Address = "$B$2" Then
　　If Range("B2") = "不可" Then
　　　 Range("B2:Z2").Interior.Color = 65535
　　End If
　End If

　If Target.Address = "$B$3" Then
　　'If Range("B2") = "不可" Then　　　　　　　←間違い
　　'　 Range("B2:Z2").Interior.Color = 65535　←間違い
　　If Range("B3") = "不可" Then　　　　　　　'←正解
　　　 Range("B3:Z3").Interior.Color = 65535　'←正解
　　End If
　End If

　'If Target.Address =・・・
　' End If
End Sub

・ツリー全体表示


	【76688】Re:セルの内容が変わったときの記述方法

独覚 - 15/2/27(金) 9:49 -


	引用なし

	パスワード

>B2セルが変更されたときにB2セルが「不可」だったらB2セルからZ2セルまで、B3セルが
>変更されたときにB3セルが「不可」だったらB3セルからZ3セルまで
このパターンだとした場合です。

Private Sub Worksheet_change(ByVal Target As Range)
　　Dim WK_RANGE　As Range
　
　　If Intersect(Target, Range("B2:B100")) Is Nothing Then Exit Sub
　
　　For Each WK_RANGE In Intersect(Target, Range("B2:B100"))
　　　　If WK_RANGE.Value = "不可" Then
　　　　　　WK_RANGE.Resize(, 25).Interior.Color = 65535
　　　　Else
　　　　　　WK_RANGE.Resize(, 25).Interior.Pattern = xlNone
　　　　End If
　　Next
End Sub

・ツリー全体表示


	【76687】Re:セルの内容が変わったときの記述方法

β - 15/2/27(金) 9:33 -


	引用なし

	パスワード

▼gg56 さん：

こんにちは
こんなことですか？

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim r As Range
　　Dim c As Range
　　
　　Set r = Intersect(Target, Range("B2:B100"))
　　
　　If r Is Nothing Then Exit Sub
　　
　　For Each c In r
　　　　With c.EntireRow.Range("B1:Z1").Interior
　　　　　　.ColorIndex = xlNone
　　　　　　If c.Value = "不可" Then .Color = vbYellow
　　　　End With
　　Next
　　
End Sub

・ツリー全体表示


	【76686】Re:セルの内容が変わったときの記述方法

独覚 - 15/2/27(金) 9:29 -


	引用なし

	パスワード

▼gg56 さん：

書かれているＶＢＡから読み取るとB2セルからB100セルの内容が変更されたときにB2セルが
「不可」であればB2セルからZ2セルまでの色を変える、と言うことでいいのかな？

B2セルが変更されたときにB2セルが「不可」だったらB2セルからZ2セルまで、B3セルが
変更されたときにB3セルが「不可」だったらB3セルからZ3セルまで、ということでは無く？

・ツリー全体表示


	【76685】セルの内容が変わったときの記述方法

gg56 - 15/2/27(金) 9:20 -


	引用なし

	パスワード

お世話になります。
Range("A1:Z100")にデータが入っています。
Range("$B$2")からRange("$B$100")の内容を変えると
対応する行の色を変えたいのですが

(質問)B列に対しての下記コードをそれぞれ99回記述するしかないのでしょうか？
　　　より簡便な記述があればご教示ください。

Private Sub Worksheet_change(ByVal Target As Range)
　If Target.Address = "$B$2" Then
　　If Range("B2") = "不可" Then
　　　 Range("B2:Z2").Interior.Color = 65535
　　End If
　End If

　If Target.Address = "$B$3" Then
　　If Range("B2") = "不可" Then
　　　 Range("B2:Z2").Interior.Color = 65535
　　End If
　End If

　'If Target.Address =・・・
　' End If
End Sub

・ツリー全体表示


	【76684】Re:条件別で選択するシートを変え、シー...

さとちぃ - 15/2/26(木) 15:47 -


	引用なし

	パスワード

▼kanabun さん：
>▼さとちぃさん：
>
>>(1)
>>リンク先のセルにはあらかじめセルに色が塗ってありまして
>>教えていただいたプログラムですと、事前にセルに塗っていた
>>色が白色設定となり、ヒットしたセルのみ色が変わる形に
>>なっております。
>>
>>対象のセル以外は、色設定はそのままとするにはどのように
>>すればいいでしょうか？
>
>とりあえず、
>> 　r.Interior.ColorIndex = xlNone
>の行をコメントにしてください。
>　　'r.Interior.ColorIndex = xlNone
>
>
>>(2)
>>
>>Interior.Color = vbCyan
>>
>>において、文字の大きさも変えたいのですが、Fontオブジェクトで
>>設定しようと試みましたが、うまく出来ません・・・。
>
>どう試してみたのかしら？
>
>　　Do
>　　　　'ヒットしたセルがあれば色を付け、Fontsizeを変更する
>　　　　c.Interior.Color = vbCyan
>　　　　c.Font.Size = 18 '←好きなサイズ
>　　　
>　　　　Set c = r.FindNext(After:=c)
>　　Loop Until c.Address = Address1

・ツリー全体表示


	【76683】Re:検索ワードが3件以上ある場合の検索・...

kanabun - 15/2/26(木) 12:06 -


	引用なし

	パスワード

▼さとちぃさん： >マクロの記録・・・・本当に便利ですね！まぁ、ついでだから、 > Sub Macro2() > ' Macro recorded 2015/2/25 by kanabun > ' >　　 Range("A7:D14").AdvancedFilter _ >　　　　 Action:=xlFilterInPlace, _ >　　　　 CriteriaRange:=Range("C1:C4") >　　 >　　 Range("D9:D12").FormulaR1C1 = "○" >　　 ActiveSheet.ShowAllData > End Sub というマクロの記録で作ったものをもう少し汎用的にしたサンプルを示しておきます。 Sub AdvancedFilter() 　　Dim r As Range　'抽出元表範囲　　Dim c As Range　'抽出条件範囲　　　　Set r = Range("A7").CurrentRegion 　　Set c = Range("C1").CurrentRegion 　　'r表から c条件に合うデータをフィルタオプションで抽出する　　r.AdvancedFilter xlFilterInPlace, c 　　　　'1行以上抽出行があれば、D列の「可視セルだけ」に "○" 　　If r.Columns(1).SpecialCells(xlVisible).Count > 1 Then 　　　　With r.Columns(4) 　　　　　　'表の1行目は項目名なので範囲から除外する　　　　　　Intersect(.Cells, .Offset(1)).Value = "○" 　　　　End With 　　End If 　　r.Worksheet.ShowAllData End Sub

・ツリー全体表示


	【76682】文字数の多い検索ワードから少ない文字数...

さとちぃ - 15/2/26(木) 11:54 -


	引用なし

	パスワード

お世話になっております。
下記のような作業をVBAにて設定したいのですが、教えていただけませんでしょうか？

(1)シート”名刺情報”の会社名の任意のセルを選択
(2)シート"拠点情報"に移動し、アクティブセルの会社名を選択し、表示

(困っていること)
株式会社XYZの文字を読み込んだ場合、XYZの検索をあいまい検索*の設定にて行いましたが
うまく検索できません。

(対応策)
その対策として、条件式を設定し、株式会社と入った場合は株式会社という表現をなくすため
置換し、その状態で検索する。
海外の会社名もあり、株式会社という表現がない場合はそのまま検索する。

といった形で考えておりますが、他に良い方法がありますでしょうか？

シート”名刺情報”

　　　A　　　　　　　B　　　　　C　　　　　D
1　　会社名　　　検索ボタン　　部署　　　氏名
2　株式会社XYZ　　ボタン　　　営業部　　田中歳三
3　株式会社ZD　　ボタン　　　営業部　　新見悟

シート”拠点情報”

　　　A　　　　　　　B　　　　　C　　　　　D
1　　会社名　　　　拠点名　　　部署　　　氏名
2　株式会社XYZ　　　愛知　　　営業部　　田中歳三
3　株式会社ZD　　　岐阜　　　営業部　　新見悟

・ツリー全体表示


	【76681】Re:検索ワードが3件以上ある場合の検索・...

さとちぃ - 15/2/26(木) 10:11 -


	引用なし

	パスワード

KANABUN様

さとちぃです。
ただいま確認出来ました！
本当にご丁寧に教えていただき、誠にありがとうございました。
マクロの記録・・・・本当に便利ですね！
これまで複数条件の検索について、書籍を片っ端から調べていたのですが
これからマクロの記録と照らし合わせながら組んでいきたいと思います。

本当にありがとうございました！

・ツリー全体表示


	【76680】Re:検索ワードが3件以上ある場合の検索・...

kanabun - 15/2/26(木) 9:25 -


	引用なし

	パスワード

▼さとちぃさん： > 検索ワードが3件以上ある場合シートレイアウトを以下のようにして詳細設定フィルタを手動で実行する操作をマクロ記録してみてください。　　　 [A]　　　　[B]　　　 [C]　　　　　[D] [1]　　　　　　　　　　　　県名（[C1]には数式:=B7 を埋め込む）　　 [2]　　　　　　　　　　　　三重*　　 [3]　　　　　　　　　　　　静岡*　　 [4]　　　　　　　　　　　　福井* [5]　　　　　　　　　　 [6]　　　　　　　　　　 [7]　会社名　　　県名　　郵便番号　 ○チェック欄 [8]　XYZ株式会社　愛知県　 653-0028　 [9]　ZD（株）　　三重県　 991-3335　 [10] ABC（株）　　三重　　 991-2543　 [11] NHK（株）　　京都府　 876-5432　 [12] 東京商事　　福井県　 666-7777　 [13] 大阪硝子(株) 大阪府　 777-8888　 [14] (株)東都興業東京都　 999-0001　こちらでマクロ記録したものをお見せすると、以下のようです。（ただし、記録マクロから .Select Selection をとって、整形してあります） Sub Macro2() ' Macro recorded 2015/2/25 by kanabun ' 　　Range("A7:D14").AdvancedFilter Action:=xlFilterInPlace, _ 　　　　CriteriaRange:=Range("C1:C4") 　　　　Range("D9:D12").FormulaR1C1 = "○"　 'D列可視セルに "○" を一括入力　　ActiveSheet.ShowAllData End Sub これをたたき台にして汎用化していけばよいのですが...

・ツリー全体表示


	【76679】Re:ExcelからWordへ転記につきまして

マリモ - 15/2/26(木) 9:19 -


	引用なし

	パスワード

▼マナさん：
色々とありがとうございました。

今回はゆっくり考える時間が取れなくて
手書きで記入することにいたします。

時間が取れるようになりましたら、
チャレンジしてみます。

・ツリー全体表示


	【76678】Re:ExcelからWordへ転記につきまして

マナ - 15/2/26(木) 0:02 -


	引用なし

	パスワード

ブックマーク案を試してみてわかったこと。
転記するとブックマークが削除されてしまう。
書き方が間違っているのか？？？

↓のように印刷後に、Undoで元に戻せばOKですが、ちょっと不細工かも。やっぱり差し込み印刷がオススメです。

doc.bookmarks("好きな名前").Range.Text = c.Value
doc.PrintOut
doc.Undo

・ツリー全体表示


	【76677】Re:ExcelからWordへ転記につきまして

マナ - 15/2/25(水) 23:27 -


	引用なし

	パスワード

ヘッダーの指定箇所に、ブックマークを挿入しておいて、
そこに転記するようにしてもよかったかも。

＞　doc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = c.Value

・ツリー全体表示


	【76676】Re:ExcelからWordへ転記につきまして

マナ - 15/2/25(水) 22:47 -


	引用なし

	パスワード

楽なのは、ワードで差し込み印刷機能を使うことです。
マクロも不要になります。

・ツリー全体表示


	【76675】Re:ExcelからWordへ転記につきまして

マナ - 15/2/25(水) 20:27 -


	引用なし

	パスワード

とりあえず順番に転記するだけなら。

Sub test()
　　Dim wd As Object
　　Dim doc As Object
　　Dim c As Range
　　Const wdHeaderFooterPrimary = 1
　　
　　
　　On Error Resume Next
　　Set wd = GetObject(, "Word.Application")
　　If wd Is Nothing Then
　　　　Set wd = CreateObject("Word.Application")
　　End If
　　On Error GoTo 0
　　
　　wd.Visible = True
　　Set doc = wd.Documents.Open(ThisWorkbook.Path & "\test.docx")
　　
　　For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　　doc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = c.Value
　　　　doc.PrintOut
　　Next

　　doc.Close False
　　wd.Quit

　　Set doc = Nothing
　　Set wd = Nothing

End Sub

・ツリー全体表示


	【76674】Re:検索ワードが3件以上ある場合の検索・...

kanabun - 15/2/25(水) 17:11 -


	引用なし

	パスワード

▼さとちぃさん： >（三重県の場合、三重でも検索可能）フィルターオプション（2007以降ならデータ - フィルタ - 詳細設定）という手もあると思います。　　A　　　　　　　B　　　　　　　C　　　　　　D 1　　　　　　　　　　　　　　県名 2　　　　　　　　　　　　　　三重* 3　　　　　　　　　　　　　　静岡* 4　　　　　　　　　　　　　　 5 6　 7　会社名　　　　県名　　　　　　郵便番号　　○チェック欄 8　XYZ株式会社　　愛知県　　　　　653-0028 9　ZD株式会社　　三重県　　　　　991-3352　　上の例だと、検索範囲　 [A7:C9] 条件範囲　 [C1:C3]　 [C1]セルは表の項目名「県名」と同じにする。という範囲設定でフィルタを実行する（詳細設定を実行する）と、「県名」列が「三重」で始まる行または「静岡」で始まる行以外は非表示になるので、 D列で可視行を選択して数式バーに ○ を入力しそのまま Ctrl + [Enter] を押すと、可視行に一括 ○ が入力される。この操作をマクロ記録してみてください。

・ツリー全体表示


	【76673】Re:条件別で選択するシートを変え、シー...

kanabun - 15/2/25(水) 17:00 -


	引用なし

	パスワード

▼さとちぃさん： >(1) >リンク先のセルにはあらかじめセルに色が塗ってありまして >教えていただいたプログラムですと、事前にセルに塗っていた >色が白色設定となり、ヒットしたセルのみ色が変わる形に >なっております。 > >対象のセル以外は、色設定はそのままとするにはどのように >すればいいでしょうか？とりあえず、 > 　r.Interior.ColorIndex = xlNone の行をコメントにしてください。　　'r.Interior.ColorIndex = xlNone >(2) > >Interior.Color = vbCyan > >において、文字の大きさも変えたいのですが、Fontオブジェクトで >設定しようと試みましたが、うまく出来ません・・・。どう試してみたのかしら？　　Do 　　　　'ヒットしたセルがあれば色を付け、Fontsizeを変更する　　　　c.Interior.Color = vbCyan 　　　　c.Font.Size = 18 '←好きなサイズ　　　　　　　Set c = r.FindNext(After:=c) 　　Loop Until c.Address = Address1

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

287 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free