↑同じ内容を3行貼り付けること
ExcelのVBAに関する質問スレ
コード書き込みや作成依頼もOK
次スレは>>980が立てること
無理なら細かく安価指定
※前スレ
Excel VBA 質問スレ Part77
https://mevius.5ch.net/test/read.cgi/tech/1658009255/
Excel VBA 質問スレ Part78
https://mevius.5ch.net/test/read.cgi/tech/1667104996/
-
VIPQ2_EXTDAT: checked:vvvvv:1000:512:: EXT was configured
探検
Excel VBA 質問スレ Part79
■ このスレッドは過去ログ倉庫に格納されています
2023/01/28(土) 11:46:47.21ID:mBQ16TA8
536デフォルトの名無しさん
2023/04/22(土) 16:15:15.73ID:p+tyVybI >>535
そのうまくいかなったコードを貼ってくれれば色々アドバイスできるかと
そのうまくいかなったコードを貼ってくれれば色々アドバイスできるかと
537デフォルトの名無しさん
2023/04/22(土) 17:36:15.09ID:0M3hZjbD >>535
シート内検索が出来ているのならfor each で全シートにその処理を適用させればいいのでは?
ピンポイントに目的を達成できるようなコードは都合よく転がってないかと。
ChatGPTには処理ごとの指示でコード生成させて自分で組み合わせれば出来んじゃね? 知らんけど
シート内検索が出来ているのならfor each で全シートにその処理を適用させればいいのでは?
ピンポイントに目的を達成できるようなコードは都合よく転がってないかと。
ChatGPTには処理ごとの指示でコード生成させて自分で組み合わせれば出来んじゃね? 知らんけど
538ChatGPT
2023/04/22(土) 21:04:52.32ID:LRW6Fiuq Sub search_string()
Dim searchString As String
Dim found As Range
searchString = InputBox("Enter search string:") ' 検索する文字列を入力
If searchString = "" Then ' 入力された文字列が空の場合、処理を終了する
Exit Sub
End If
Set found = ActiveWorkbook.Sheets(1).Cells.Find(What:=searchString) ' ブック全体から検索
If Not found Is Nothing Then ' 検索結果が見つかった場合
found.Select ' 該当するセルを選択状態にする
MsgBox "Found at " & found.Address
Else ' 検索結果が見つからなかった場合
MsgBox "Not found"
End If
End Sub
Dim searchString As String
Dim found As Range
searchString = InputBox("Enter search string:") ' 検索する文字列を入力
If searchString = "" Then ' 入力された文字列が空の場合、処理を終了する
Exit Sub
End If
Set found = ActiveWorkbook.Sheets(1).Cells.Find(What:=searchString) ' ブック全体から検索
If Not found Is Nothing Then ' 検索結果が見つかった場合
found.Select ' 該当するセルを選択状態にする
MsgBox "Found at " & found.Address
Else ' 検索結果が見つからなかった場合
MsgBox "Not found"
End If
End Sub
539535
2023/04/22(土) 22:12:10.97ID:xZH2QK6p 返信遅れてすみませんでした。何故か書き込めず。
for eachで回すようにして作ってみます。ありがとうございました。
>>538
found.Select 似たようなコードが出来たんですが、selectメソッドで失敗になるのですよね。
for eachで回すようにして作ってみます。ありがとうございました。
>>538
found.Select 似たようなコードが出来たんですが、selectメソッドで失敗になるのですよね。
540デフォルトの名無しさん
2023/04/22(土) 23:52:52.89ID:EIwvRS0u だから使えんと
541デフォルトの名無しさん
2023/04/23(日) 01:54:53.75ID:4djiLfGu ChatGPTがダメなら
マクロ先生がいるじゃない
マクロ先生がいるじゃない
542デフォルトの名無しさん
2023/04/23(日) 04:50:32.07ID:FpfGPbf0 知恵袋先生がいるじゃんか
vbキチがいる。
vbキチがいる。
543デフォルトの名無しさん
2023/04/23(日) 05:04:42.20ID:Jetoe3O6 >>538のChatGPTの回答は、検索範囲をSheets(1)と指定してるから1枚目のシートしか検索しない(ActiveSheetではない点に注意)
そもそも、Excelを手動で操作する時は「ブック」を指定して一発検索ができるのに、この機能がなぜかVBAからは使えない仕様になっている
だからループで全シート回すよう書き換えるしかない
そもそも、Excelを手動で操作する時は「ブック」を指定して一発検索ができるのに、この機能がなぜかVBAからは使えない仕様になっている
だからループで全シート回すよう書き換えるしかない
544デフォルトの名無しさん
2023/04/23(日) 05:20:45.59ID:Jetoe3O6 それをふまえてChatGPTに再質問すれば、ちゃんとループするコードに直してくれる
結局は便利な道具(AI)があっても、使い方が悪いと思ったとおりの結果を出してくれないってこと
https://i.imgur.com/UEY1EGX.png
結局は便利な道具(AI)があっても、使い方が悪いと思ったとおりの結果を出してくれないってこと
https://i.imgur.com/UEY1EGX.png
545デフォルトの名無しさん
2023/04/23(日) 07:03:22.97ID:NdK96c6n 自力でできる奴はAIで調べる必要がない
546デフォルトの名無しさん
2023/04/23(日) 09:10:23.27ID:vhYO2P62 マクロを記録しながら手動実行して、記録されたマクロを参考にすれば上手くいくことがあるよ
547デフォルトの名無しさん
2023/04/23(日) 09:54:34.79ID:4djiLfGu 鳥取県がChatGPT禁止 平井知事「民主主義の自殺」 [ぐれ★]
https://asahi.5ch.net/test/read.cgi/newsplus/1682203494/
https://asahi.5ch.net/test/read.cgi/newsplus/1682203494/
548デフォルトの名無しさん
2023/04/23(日) 17:24:04.25ID:uraPIYbl 儲かる株を教えてくれるAIは無いんかね
549デフォルトの名無しさん
2023/04/23(日) 17:26:28.29ID:vhYO2P62 あるよ
550デフォルトの名無しさん
2023/04/23(日) 18:09:32.94ID:0jCY5BzY 今のAIはネットから情報を集めてくるだけで未来を予測する機能はない
予測サイトからデータを拾ってくることならできるけど、それはAIの予測とは言えない
予測サイトからデータを拾ってくることならできるけど、それはAIの予測とは言えない
551デフォルトの名無しさん
2023/04/23(日) 21:46:07.09ID:OJTKX0Sp AIをなんだと思ってるの
552デフォルトの名無しさん
2023/04/23(日) 22:49:42.49ID:FpfGPbf0 横着するためのツールだと思ってる
553デフォルトの名無しさん
2023/04/23(日) 23:19:15.43ID:LSSzz9o8 チャットGTPの種明かしだって結局は「データベース」にある事を答えているだけ
だからデータベースにない事は途端に破綻して頓珍漢な回答をする、これが「自信満々に間違える」という事
もっというとシュミレーションするスーパーコンピューターはあるそのシュミレーション結果が正しいわけではないので人間が判断して正しくない計算結果は全て切り捨てて正しい答えだけ残しているらしいです
だからデータベースにない事は途端に破綻して頓珍漢な回答をする、これが「自信満々に間違える」という事
もっというとシュミレーションするスーパーコンピューターはあるそのシュミレーション結果が正しいわけではないので人間が判断して正しくない計算結果は全て切り捨てて正しい答えだけ残しているらしいです
554デフォルトの名無しさん
2023/04/23(日) 23:54:35.39ID:73FkKQIb 犯罪にAIを使い始めたら厄介だな
555デフォルトの名無しさん
2023/04/23(日) 23:55:25.14ID:LSSzz9o8 >>554
データベース化笑できるんじゃない?
データベース化笑できるんじゃない?
556デフォルトの名無しさん
2023/04/24(月) 00:43:15.46ID:ay19AT0z557デフォルトの名無しさん
2023/04/24(月) 00:54:10.45ID:ay19AT0z 辞書が検索エンジンに切り替わって手間が省けるようになった流れの新たなブレイクスルーだろうな
知りたいことを探すときに単語に置き換えて色々なページから探していた無駄を省いてくれる
知りたいことを探すときに単語に置き換えて色々なページから探していた無駄を省いてくれる
558デフォルトの名無しさん
2023/04/24(月) 01:28:52.70ID:CUqhGEZn >>556
違います
科学のシュミレーションを行うシュミレーションシステムはありますがシステムは正しい答えを必ずしも出すというわけではないので人間が計算結果を見て正しくない計算結果を削除し、正しいと判断したものだけを残すという形で精度や性能を向上させているそうです
これはチャットGTPにそっくりそのまま当て嵌まるし、なんらチャットGTPは革新的でもないという証拠です
そもそも知能や知性があるならなぜ出鱈目な答えを自信満々に出して間違えるのでしょうか?
違います
科学のシュミレーションを行うシュミレーションシステムはありますがシステムは正しい答えを必ずしも出すというわけではないので人間が計算結果を見て正しくない計算結果を削除し、正しいと判断したものだけを残すという形で精度や性能を向上させているそうです
これはチャットGTPにそっくりそのまま当て嵌まるし、なんらチャットGTPは革新的でもないという証拠です
そもそも知能や知性があるならなぜ出鱈目な答えを自信満々に出して間違えるのでしょうか?
559デフォルトの名無しさん
2023/04/24(月) 02:06:49.66ID:BWKTcRvI 馬鹿が使う用語
↓
シミュレーション
↓
シミュレーション
560デフォルトの名無しさん
2023/04/24(月) 02:07:59.37ID:BWKTcRvI あ、俺が馬鹿か
漢字変換が勝手に修正する…
シュミレーションと書くのは馬鹿
漢字変換が勝手に修正する…
シュミレーションと書くのは馬鹿
561デフォルトの名無しさん
2023/04/24(月) 02:11:33.72ID:7Q5zeCBn >>558
馬鹿は間違っていることに気づかないからだろ
馬鹿は間違っていることに気づかないからだろ
562デフォルトの名無しさん
2023/04/24(月) 02:11:47.58ID:CUqhGEZn 例えば藤井聡太さんだってAIで将棋の研究をしているとは言いますがそれはAIが出したシュミレーション結果のいいデータ、答えだけを切り取っているという事なのでは?
563デフォルトの名無しさん
2023/04/24(月) 02:12:28.98ID:dU5ByQ7u >>562
馬鹿は黙れ
馬鹿は黙れ
564デフォルトの名無しさん
2023/04/24(月) 02:34:30.02ID:FQlyTijh 海外チェスで遠隔アナルバイブ振動でAIの答え座標を受信して不正してた奴いたけど
フジー君もやってねえだろうな PC詳しいしアナル好きそうだし…w
フジー君もやってねえだろうな PC詳しいしアナル好きそうだし…w
565デフォルトの名無しさん
2023/04/24(月) 03:07:44.21ID:CUqhGEZn >>563
じゃあなんでチャットGTPは自信満々にまちがえるのです?
じゃあなんでチャットGTPは自信満々にまちがえるのです?
566デフォルトの名無しさん
2023/04/24(月) 04:15:23.35ID:MMCAzh7R 馬鹿をだまして金とる戦略
567デフォルトの名無しさん
2023/04/24(月) 04:22:29.70ID:ay19AT0z568デフォルトの名無しさん
2023/04/24(月) 06:04:55.41ID:bY+5L6EV 「simu」を「シュミ」とは読まないだろう、という単純なことも理解できないレベル
半角だと環境によってはわかりにくくなるからあえて全角で書いた
半角だと環境によってはわかりにくくなるからあえて全角で書いた
569デフォルトの名無しさん
2023/04/24(月) 07:31:46.75ID:pba/8KUE ここはChatGPTの話題が出るだけで簡単に荒れるな
570デフォルトの名無しさん
2023/04/24(月) 07:40:26.28ID:nNpEvIsc ここだけじゃないよ
571デフォルトの名無しさん
2023/04/24(月) 07:41:51.55ID:pba/8KUE スルーするだけで済む話なのにスレタイ読めないのか、
はたまた自作自演で荒らしてるのか
はたまた自作自演で荒らしてるのか
572デフォルトの名無しさん
2023/04/24(月) 07:53:53.38ID:ltCEeSXK スルーしろと言うやつほど一番スルーできてない
573デフォルトの名無しさん
2023/04/24(月) 07:56:06.50ID:5kcFhqjo 昔は良スレだったのにな。
ひとつの話題で荒れすぎ
ひとつの話題で荒れすぎ
574デフォルトの名無しさん
2023/04/24(月) 08:01:16.77ID:pba/8KUE >>572
一番の意味くらい知っておいたほうが幸せになれるよ
一番の意味くらい知っておいたほうが幸せになれるよ
575デフォルトの名無しさん
2023/04/24(月) 08:11:57.10ID:4N3isGNg 別に誰のことか言ってない一般論に過剰反応するの図星すぎて笑える
576デフォルトの名無しさん
2023/04/24(月) 08:37:49.72ID:Z0B9bFh/ こっちのスレ要らなくね?
577デフォルトの名無しさん
2023/04/24(月) 09:00:06.24ID:clOk4EBF 必要ないと思ったなら見なきゃいいだけ
578デフォルトの名無しさん
2023/04/24(月) 09:46:37.76ID:5kcFhqjo もう全部スルーしてrom専で
579デフォルトの名無しさん
2023/04/24(月) 12:51:06.36ID:ay19AT0z スレ違いとかいうやつは見なければいいだけだろ。
番組はこうじゃなきゃいけないとかテレビ局に凸電する危地害なのか?
番組はこうじゃなきゃいけないとかテレビ局に凸電する危地害なのか?
580デフォルトの名無しさん
2023/04/24(月) 15:11:25.30ID:Spd75cS3 そら公共電波だしな
ウンコ垂れ流され続けたら苦情も行くだろ
ウンコ垂れ流され続けたら苦情も行くだろ
581デフォルトの名無しさん
2023/04/24(月) 21:31:31.58ID:5kcFhqjo ウンコ言うな
582デフォルトの名無しさん
2023/04/24(月) 21:41:33.70ID:LZZeUipz 嫌なら見るな
苦情を言って変わるわけないのに、無駄だとわからない時点でアホ
苦情を言って変わるわけないのに、無駄だとわからない時点でアホ
583デフォルトの名無しさん
2023/04/25(火) 15:23:16.15ID:jvAnjjKM 言い方キツイがど正論だな。
嫌なら開かなければ良いな。
嫌なら開かなければ良いな。
584デフォルトの名無しさん
2023/04/25(火) 16:01:52.20ID:PhYPsJWz 逆だな、読んだから嫌な書き込みだと判断したんだろ
585デフォルトの名無しさん
2023/04/25(火) 16:32:47.24ID:OOi8qz2x ズレてるぞ おっさん 逆だな、とかどの立場で物申してるか片腹痛いわ
586デフォルトの名無しさん
2023/04/25(火) 16:45:08.15ID:/PKfXSpu 仮に公道にウンコ垂れ流し続けて嫌なら見るな主張しても警察が動くよな知らんけど
だとしたら公共電波のウンコ垂れ流しも取り締まられるべきと考えるのはそんなに不自然だろうか
だとしたら公共電波のウンコ垂れ流しも取り締まられるべきと考えるのはそんなに不自然だろうか
587デフォルトの名無しさん
2023/04/25(火) 18:48:14.50ID:PhYPsJWz 垂れ流されているのが本当にウンコかどうかは見なければわからんだろ
ウンコが垂れ流されている公道を目をつぶって歩いたらウンコまみれになるぞ
ウンコが垂れ流されている公道を目をつぶって歩いたらウンコまみれになるぞ
588デフォルトの名無しさん
2023/04/25(火) 19:06:12.65ID:jvAnjjKM ウンコばかり言ってるとクソスレになっちまう!
589デフォルトの名無しさん
2023/04/25(火) 20:00:09.95ID:mmdaU32E 5chの場合は然るべき話題をすべく板やスレッドが別れてるわけだからな
スレの内容に沿った結果で不快な気持ちになることはあっても、
嫌なら見るなはスレ違いや板違いって概念のある5chにおいては全く正論ではない
スレの内容に沿った結果で不快な気持ちになることはあっても、
嫌なら見るなはスレ違いや板違いって概念のある5chにおいては全く正論ではない
590デフォルトの名無しさん
2023/04/25(火) 20:03:38.76ID:mmdaU32E591デフォルトの名無しさん
2023/04/25(火) 23:00:49.89ID:jvAnjjKM まだ喧嘩してる
592デフォルトの名無しさん
2023/04/25(火) 23:02:46.35ID:OzfCSZRC593デフォルトの名無しさん
2023/04/26(水) 00:36:38.80ID:zxzdUrHn >>590
脱線が酷いとよくないのは解らんでもない
だがそれにもまして多少の脱線でも管理人気取りで言ってくるやつのほうがウザい
まるでゴミ捨て場のゴミチェックしてるジジイだ
そういう行動が心理的リアクタンスを生んでるんだよ
脱線が酷いとよくないのは解らんでもない
だがそれにもまして多少の脱線でも管理人気取りで言ってくるやつのほうがウザい
まるでゴミ捨て場のゴミチェックしてるジジイだ
そういう行動が心理的リアクタンスを生んでるんだよ
594デフォルトの名無しさん
2023/04/26(水) 08:58:25.55ID:1pxgk3Hs ここしばらくの脱線は多少ですまなくね?
595デフォルトの名無しさん
2023/04/26(水) 10:16:58.77ID:L1Mj70sJ 俯瞰するとGPTという脅威が出現して自分の価値喪失を感じる爺の焦りか
596デフォルトの名無しさん
2023/04/26(水) 10:32:27.26ID:w70Lrl+B 多少で済むくね?
597デフォルトの名無しさん
2023/04/26(水) 11:34:39.03ID:FZ0Navbz 行ごとに比較の数式を使った条件付き書式設定はVBAで書かないと無理ですか?
コピーしても絶対参照になって反映されず。
列A行i>列B行i×2の時、列A行iを黄色で塗りつぶし作業です。
コピーしても絶対参照になって反映されず。
列A行i>列B行i×2の時、列A行iを黄色で塗りつぶし作業です。
598デフォルトの名無しさん
2023/04/26(水) 11:50:15.79ID:MQck+7xp >>597
絶対参照と相対参照の使い分けはセル番地に $ 記号を付ける
絶対参照と相対参照の使い分けはセル番地に $ 記号を付ける
599デフォルトの名無しさん
2023/04/26(水) 14:39:17.86ID:FZ0Navbz600デフォルトの名無しさん
2023/04/26(水) 18:26:19.83ID:QhJ3494d chatgptのvba専用スレ立てれば良くね?
601デフォルトの名無しさん
2023/04/27(木) 05:48:02.31ID:+yZZBsrI ChatGPT ってそんなに凄いんか
今度「EXCEL VBAでマリオ作ってください」って書いてみようかな
出来なければ無能
今度「EXCEL VBAでマリオ作ってください」って書いてみようかな
出来なければ無能
602デフォルトの名無しさん
2023/04/27(木) 06:49:22.19ID:76bSpVKu 頭悪そう
603デフォルトの名無しさん
2023/04/27(木) 13:34:04.47ID:dzjZcYac >>601
Excel VBAでマリオを作ることは可能ですが、かなり複雑な作業になります。そのため、以下に示すのは、簡単なマリオゲームの作り方の一例です。
ゲーム画面を作成する
最初に、Excelワークシート上にゲーム画面を作成します。これには、背景、床、壁などが含まれます。背景と床は、Excelのシェイプを使用して作成することができます。壁は、VBAで作成する必要があります。
マリオキャラクターを作成する
マリオキャラクターを作成するために、Excelのシェイプを使用します。キャラクターは、右に進む、左に進む、ジャンプする、しゃがむなどのアクションを実行できるようにする必要があります。これには、キーボードの矢印キーを使用することができます。
Excel VBAでマリオを作ることは可能ですが、かなり複雑な作業になります。そのため、以下に示すのは、簡単なマリオゲームの作り方の一例です。
ゲーム画面を作成する
最初に、Excelワークシート上にゲーム画面を作成します。これには、背景、床、壁などが含まれます。背景と床は、Excelのシェイプを使用して作成することができます。壁は、VBAで作成する必要があります。
マリオキャラクターを作成する
マリオキャラクターを作成するために、Excelのシェイプを使用します。キャラクターは、右に進む、左に進む、ジャンプする、しゃがむなどのアクションを実行できるようにする必要があります。これには、キーボードの矢印キーを使用することができます。
604デフォルトの名無しさん
2023/04/27(木) 13:35:04.43ID:dzjZcYac 敵キャラクターを作成する
マリオゲームには、いくつかの敵キャラクターが含まれます。これらは、Excelのシェイプを使用して作成することができます。敵キャラクターは、マリオキャラクターに衝突すると、マリオがライフを失うことになります。
ゲームループを作成する
ゲームループは、ゲームの進行を管理するために必要なものです。これには、マリオキャラクターと敵キャラクターの移動、衝突の検出、スコアの計算などが含まれます。
ゲームオーバー画面を作成する
ゲームオーバー画面は、マリオがすべてのライフを失ったときに表示されます。これには、Excelのシェイプを使用して作成することができます。
以上が、Excel VBAで簡単なマリオゲームを作成するための一般的な手順です。ただし、Excel VBAで本格的なゲームを作成するためには、より高度なプログラミング技術が必要となります。
マリオゲームには、いくつかの敵キャラクターが含まれます。これらは、Excelのシェイプを使用して作成することができます。敵キャラクターは、マリオキャラクターに衝突すると、マリオがライフを失うことになります。
ゲームループを作成する
ゲームループは、ゲームの進行を管理するために必要なものです。これには、マリオキャラクターと敵キャラクターの移動、衝突の検出、スコアの計算などが含まれます。
ゲームオーバー画面を作成する
ゲームオーバー画面は、マリオがすべてのライフを失ったときに表示されます。これには、Excelのシェイプを使用して作成することができます。
以上が、Excel VBAで簡単なマリオゲームを作成するための一般的な手順です。ただし、Excel VBAで本格的なゲームを作成するためには、より高度なプログラミング技術が必要となります。
605デフォルトの名無しさん
2023/04/27(木) 14:08:46.28ID:XSILjXL+ この部分のサンプルコードを教えて言うと一応コード書き始めるからな
問い質し続けるだけで何の技術も必要なくマリオが完成するかもしれん
問い質し続けるだけで何の技術も必要なくマリオが完成するかもしれん
606デフォルトの名無しさん
2023/04/27(木) 14:11:45.77ID:zVEPCm55 単純にマクロでゲーム作れる奴すげーし
607デフォルトの名無しさん
2023/04/27(木) 15:59:16.33ID:tbrdsB1h 作れるわけねーわな、あと著作権もあるし
608デフォルトの名無しさん
2023/04/27(木) 16:50:28.16ID:XSILjXL+ AIに人権はないから著作権も存在しない
マリオといっても花札屋のとは限らんしな
マリオといっても花札屋のとは限らんしな
609デフォルトの名無しさん
2023/04/27(木) 17:13:01.50ID:Ocl0clWf 作る人が多くなるとマリオのようなゲームのコードのテンプレのようなものがデータセットの中にできてきて
即答するようになるw
即答するようになるw
610デフォルトの名無しさん
2023/04/27(木) 18:09:30.67ID:DM4R6GlX >>608
著作権無視は違法ですが
著作権無視は違法ですが
611デフォルトの名無しさん
2023/04/27(木) 18:22:26.88ID:lojChHXv >>610
AIという道具を使った奴が違法な
AIという道具を使った奴が違法な
612デフォルトの名無しさん
2023/04/28(金) 12:20:31.67ID:BvI4vGh+ 罫線を引くコードはマクロの記録をしたものを加工するのが最善?
613デフォルトの名無しさん
2023/04/28(金) 12:28:24.02ID:vB455QFk いいえ
614デフォルトの名無しさん
2023/04/28(金) 12:42:10.09ID:FbKok5Di マクロ記録をそのまま使うなんて90年代のやり方
615デフォルトの名無しさん
2023/04/28(金) 12:49:48.27ID:vB455QFk そのままとはどこにも書いてない
616デフォルトの名無しさん
2023/04/28(金) 13:08:25.63ID:E6P3bOF0 お前は他人の否定ばかりだな?
617デフォルトの名無しさん
2023/04/28(金) 13:16:17.73ID:/vDIlpFT Private Sub Bttn_click()
Dim cT, cL, cW, cH, CR, CG, CB As Single
Dim cAd As String
Dim X0, Y0, W1, H1 As Variant
Dim shp As Object
cAd = Selection.Address(ColumnAbsolute:=False, RowAbsolute:=False)
If Selection(1).Row < 4 Or Selection(1).Column < 4 Then
MsgBox "描画の範囲外が選択されています" & vbCrLf, vbExclamation, "! 範囲外 !"
Exit Sub
End If
If Selection(Selection.Count).Row > 43 Or Selection(Selection.Count).Column > 65 Then
MsgBox "描画の範囲外が選択されています" & vbCrLf, vbExclamation, "! 範囲外 !"
Exit Sub
End If
If Selection.Rows.Count > 1 Then
MsgBox "複数行が選択されています" & vbCrLf, vbExclamation, "! 選択チェック !"
Exit Sub
End If
If Selection.Columns.Count > 2 Then
MsgBox "3列以上が選択されています" & vbCrLf, vbExclamation, "! 選択チェック !"
Exit Sub
End If
--------------- 続きあり
Dim cT, cL, cW, cH, CR, CG, CB As Single
Dim cAd As String
Dim X0, Y0, W1, H1 As Variant
Dim shp As Object
cAd = Selection.Address(ColumnAbsolute:=False, RowAbsolute:=False)
If Selection(1).Row < 4 Or Selection(1).Column < 4 Then
MsgBox "描画の範囲外が選択されています" & vbCrLf, vbExclamation, "! 範囲外 !"
Exit Sub
End If
If Selection(Selection.Count).Row > 43 Or Selection(Selection.Count).Column > 65 Then
MsgBox "描画の範囲外が選択されています" & vbCrLf, vbExclamation, "! 範囲外 !"
Exit Sub
End If
If Selection.Rows.Count > 1 Then
MsgBox "複数行が選択されています" & vbCrLf, vbExclamation, "! 選択チェック !"
Exit Sub
End If
If Selection.Columns.Count > 2 Then
MsgBox "3列以上が選択されています" & vbCrLf, vbExclamation, "! 選択チェック !"
Exit Sub
End If
--------------- 続きあり
618デフォルトの名無しさん
2023/04/28(金) 13:18:29.67ID:/vDIlpFT If (Selection(1).Row Mod 2) = 0 Then
CR = 255
CG = 0
CB = 0
Else
CR = 0
CG = 0
CB = 255
End If
With ActiveSheet.Range(cAd)
cT = .Top
cL = .Left
cW = .Width
cH = .Height
End With
If Selection.Columns.Count = 1 Then
X0 = cL + (cW / 2) - 1
Y0 = cT + 2
W1 = cW / 8
H1 = cH - 4
Else
X0 = cL + (cW / 2 - 1)
Y0 = cT + 2
W1 = cW / 16
H1 = cH - 4
End If
----------------- 続きあり
CR = 255
CG = 0
CB = 0
Else
CR = 0
CG = 0
CB = 255
End If
With ActiveSheet.Range(cAd)
cT = .Top
cL = .Left
cW = .Width
cH = .Height
End With
If Selection.Columns.Count = 1 Then
X0 = cL + (cW / 2) - 1
Y0 = cT + 2
W1 = cW / 8
H1 = cH - 4
Else
X0 = cL + (cW / 2 - 1)
Y0 = cT + 2
W1 = cW / 16
H1 = cH - 4
End If
----------------- 続きあり
619デフォルトの名無しさん
2023/04/28(金) 13:29:30.38ID:/vDIlpFT Set shp = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, X0, Y0, W1, H1)
shp.Line.Weight = 0.1
shp.Line.ForeColor.RGB = RGB(CR, CG, CB)
shp.Fill.Visible = True
shp.Fill.ForeColor.RGB = RGB(CR, CG, CB)
Range(cAd).Select
End Sub
セルD4:BM43までの範囲内に限定
一項目二行を使って上段が予定下段が実行などで判断できるように上下で線の色分け
斜線は引けない
図形のパターンは4種 直線・矢印線・縦棒・細い▲
shp.Line.Weight = 0.1
shp.Line.ForeColor.RGB = RGB(CR, CG, CB)
shp.Fill.Visible = True
shp.Fill.ForeColor.RGB = RGB(CR, CG, CB)
Range(cAd).Select
End Sub
セルD4:BM43までの範囲内に限定
一項目二行を使って上段が予定下段が実行などで判断できるように上下で線の色分け
斜線は引けない
図形のパターンは4種 直線・矢印線・縦棒・細い▲
620デフォルトの名無しさん
2023/04/28(金) 13:31:15.83ID:/vDIlpFT Private Sub Bttn2_Click()
Dim rr As Range
If TypeName(Selection) <> "Range" Then Exit Sub
Set rr = Selection
If rr.Row Mod 2 = 0 Then
rr.Parent.Shapes.AddLine(rr.Left + 2, rr.Top + 4, rr.Left + rr.Width - 1, rr.Top + 4).Select
With Selection.ShapeRange.Line
.EndArrowheadStyle = msoArrowheadTriangle
.EndArrowheadLength = msoArrowheadLengthMedium
.EndArrowheadWidth = msoArrowheadWidthMedium
.Weight = 2
.ForeColor.RGB = RGB(255, 0, 0)
End With
Else
rr.Parent.Shapes.AddLine(rr.Left + 2, rr.Top + 4, rr.Left + rr.Width - 1, rr.Top + 4).Select
With Selection.ShapeRange.Line
.EndArrowheadStyle = msoArrowheadTriangle
.EndArrowheadLength = msoArrowheadLengthMedium
.EndArrowheadWidth = msoArrowheadWidthMedium
.Weight = 2
.ForeColor.RGB = RGB(0, 0, 255)
End With
End If
rr.Select
End Sub
Dim rr As Range
If TypeName(Selection) <> "Range" Then Exit Sub
Set rr = Selection
If rr.Row Mod 2 = 0 Then
rr.Parent.Shapes.AddLine(rr.Left + 2, rr.Top + 4, rr.Left + rr.Width - 1, rr.Top + 4).Select
With Selection.ShapeRange.Line
.EndArrowheadStyle = msoArrowheadTriangle
.EndArrowheadLength = msoArrowheadLengthMedium
.EndArrowheadWidth = msoArrowheadWidthMedium
.Weight = 2
.ForeColor.RGB = RGB(255, 0, 0)
End With
Else
rr.Parent.Shapes.AddLine(rr.Left + 2, rr.Top + 4, rr.Left + rr.Width - 1, rr.Top + 4).Select
With Selection.ShapeRange.Line
.EndArrowheadStyle = msoArrowheadTriangle
.EndArrowheadLength = msoArrowheadLengthMedium
.EndArrowheadWidth = msoArrowheadWidthMedium
.Weight = 2
.ForeColor.RGB = RGB(0, 0, 255)
End With
End If
rr.Select
End Sub
621デフォルトの名無しさん
2023/04/28(金) 13:32:22.25ID:/vDIlpFT Private Sub Bttn3_Click()
Dim rr As Range
If TypeName(Selection) <> "Range" Then Exit Sub
Set rr = Selection
If rr.Row Mod 2 = 0 Then
rr.Parent.Shapes.AddLine(rr.Left + 2, rr.Top + 4, rr.Left + rr.Width - 1, rr.Top + 4).Select
With Selection.ShapeRange.Line
.Weight = 3
.ForeColor.RGB = RGB(255, 0, 0)
End With
Else
rr.Parent.Shapes.AddLine(rr.Left + 2, rr.Top + 4, rr.Left + rr.Width - 1, rr.Top + 4).Select
With Selection.ShapeRange.Line
.Weight = 3
.ForeColor.RGB = RGB(0, 0, 255)
End With
End If
rr.Select
End Sub
Dim rr As Range
If TypeName(Selection) <> "Range" Then Exit Sub
Set rr = Selection
If rr.Row Mod 2 = 0 Then
rr.Parent.Shapes.AddLine(rr.Left + 2, rr.Top + 4, rr.Left + rr.Width - 1, rr.Top + 4).Select
With Selection.ShapeRange.Line
.Weight = 3
.ForeColor.RGB = RGB(255, 0, 0)
End With
Else
rr.Parent.Shapes.AddLine(rr.Left + 2, rr.Top + 4, rr.Left + rr.Width - 1, rr.Top + 4).Select
With Selection.ShapeRange.Line
.Weight = 3
.ForeColor.RGB = RGB(0, 0, 255)
End With
End If
rr.Select
End Sub
622デフォルトの名無しさん
2023/04/28(金) 13:33:33.67ID:/vDIlpFT Private Sub Bttn4_Click()
Dim rr As Range
If TypeName(Selection) <> "Range" Then Exit Sub
Set rr = Selection
If rr.Row Mod 2 = 0 Then
rr.Parent.Shapes.AddLine(rr.Left + rr.Width - 2, rr.Top + 1, rr.Left + rr.Width - 2, rr.Top + rr.Height - 1).Select
With Selection.ShapeRange.Line
.Weight = 3
.ForeColor.RGB = RGB(255, 0, 0)
End With
Else
rr.Parent.Shapes.AddLine(rr.Left + rr.Width - 2, rr.Top + 1, rr.Left + rr.Width - 2, rr.Top + rr.Height - 1).Select
With Selection.ShapeRange.Line
.Weight = 3
.ForeColor.RGB = RGB(0, 0, 255)
End With
End If
rr.Select
End Sub
Dim rr As Range
If TypeName(Selection) <> "Range" Then Exit Sub
Set rr = Selection
If rr.Row Mod 2 = 0 Then
rr.Parent.Shapes.AddLine(rr.Left + rr.Width - 2, rr.Top + 1, rr.Left + rr.Width - 2, rr.Top + rr.Height - 1).Select
With Selection.ShapeRange.Line
.Weight = 3
.ForeColor.RGB = RGB(255, 0, 0)
End With
Else
rr.Parent.Shapes.AddLine(rr.Left + rr.Width - 2, rr.Top + 1, rr.Left + rr.Width - 2, rr.Top + rr.Height - 1).Select
With Selection.ShapeRange.Line
.Weight = 3
.ForeColor.RGB = RGB(0, 0, 255)
End With
End If
rr.Select
End Sub
623デフォルトの名無しさん
2023/04/28(金) 13:39:54.72ID:/vDIlpFT Bttn 細い▲ スタート位置など(打ち合わせ・協議など)
Bttn2 矢印線 ライン矢印付き
Bttn3 直線
Bttn4 縦棒 完了など 以下おまけ BDel 選択された範囲内のシェイプを全削除
Private Sub BDel_Click()
Call shpDel(Selection)
End Sub
Sub shpDel(ByVal mR As Range)
Dim mLo As Long, mCh As Boolean
mCh = True
For mLo = 1 To mR.Worksheet.Shapes.Count
With mR.Worksheet.Shapes(mLo)
If Intersect(.TopLeftCell, mR) Is Nothing Then
ElseIf Intersect(.BottomRightCell, mR) Is Nothing Then
Else
.Select Replace:=mCh
mCh = False
End If
End With
Next mLo
If Not mCh Then
Selection.ShapeRange.Delete
End If
mR.Select
Application.ScreenUpdating = True
End Sub
Bttn2 矢印線 ライン矢印付き
Bttn3 直線
Bttn4 縦棒 完了など 以下おまけ BDel 選択された範囲内のシェイプを全削除
Private Sub BDel_Click()
Call shpDel(Selection)
End Sub
Sub shpDel(ByVal mR As Range)
Dim mLo As Long, mCh As Boolean
mCh = True
For mLo = 1 To mR.Worksheet.Shapes.Count
With mR.Worksheet.Shapes(mLo)
If Intersect(.TopLeftCell, mR) Is Nothing Then
ElseIf Intersect(.BottomRightCell, mR) Is Nothing Then
Else
.Select Replace:=mCh
mCh = False
End If
End With
Next mLo
If Not mCh Then
Selection.ShapeRange.Delete
End If
mR.Select
Application.ScreenUpdating = True
End Sub
624デフォルトの名無しさん
2023/04/28(金) 17:18:16.62ID:/vDIlpFT 補足 :
UserForm 「BttnF」上に、描画用ボタン「Bttn、Bttn2、Bttn3、Bttn4」を貼り
それぞれのコードを割り当て
描いた図形を削除するためのボタン「mDel」も貼る
セル範囲を選択後、上記いずれかのボタンを押すことで描画したり消したり
描画するSheet上(A1:D4内に配置すればウィンドウ枠の固定をしてもズレずに済む)に
UserFormを出すボタン「cmdBttnF」を貼り Private Sub cmdBttnF_click()のコードを割り当て
他の図形の例 :
' ひし形は msoShapeDiamond
' 四つ星は msoShape4pointStar 五つ星 msoShape5pointStar
' 開始位置に戻るは msoShapeActionButtonBeginning 進む(再生)は msoShapeActionButtonForwardorNext
' 終了位置へ進むは msoShapeActionButtonEnd
' 吹き出しもできる msoShapeBalloon
' 右向き六角形 msoShapeChevron
細い▲や縦棒が嫌な場合はこれら等で
UserForm 「BttnF」上に、描画用ボタン「Bttn、Bttn2、Bttn3、Bttn4」を貼り
それぞれのコードを割り当て
描いた図形を削除するためのボタン「mDel」も貼る
セル範囲を選択後、上記いずれかのボタンを押すことで描画したり消したり
描画するSheet上(A1:D4内に配置すればウィンドウ枠の固定をしてもズレずに済む)に
UserFormを出すボタン「cmdBttnF」を貼り Private Sub cmdBttnF_click()のコードを割り当て
他の図形の例 :
' ひし形は msoShapeDiamond
' 四つ星は msoShape4pointStar 五つ星 msoShape5pointStar
' 開始位置に戻るは msoShapeActionButtonBeginning 進む(再生)は msoShapeActionButtonForwardorNext
' 終了位置へ進むは msoShapeActionButtonEnd
' 吹き出しもできる msoShapeBalloon
' 右向き六角形 msoShapeChevron
細い▲や縦棒が嫌な場合はこれら等で
625デフォルトの名無しさん
2023/04/28(金) 17:20:52.50ID:/vDIlpFT 「mDel」ぢゃ無かった「BDel」で
626デフォルトの名無しさん
2023/04/28(金) 20:20:31.50ID:xyEtsQeE 皆様お助けください
VBA、INDEX,MATCHで検索先の行の文字数を検索値に合わせたいんだができない…シート関数だったら
INDEX(A:A,MATCH(B3,MID(C:C,1,LEN(B3)),0)でできるのに、マクロでMATCHの部分を
MATCH(ACTIVECELL.MID(RANGE("C:C"),LEN(ACTIVE CELL)),0)に変えると通らない
配列をとある文字数数分だけ検索したいというだけなんですができなくて困っております
よろしく御指南のほどお願い致します
VBA、INDEX,MATCHで検索先の行の文字数を検索値に合わせたいんだができない…シート関数だったら
INDEX(A:A,MATCH(B3,MID(C:C,1,LEN(B3)),0)でできるのに、マクロでMATCHの部分を
MATCH(ACTIVECELL.MID(RANGE("C:C"),LEN(ACTIVE CELL)),0)に変えると通らない
配列をとある文字数数分だけ検索したいというだけなんですができなくて困っております
よろしく御指南のほどお願い致します
627click
2023/04/28(金) 21:21:39.24ID:EQuQ1pVF >>626
Sub SearchText()
Dim searchText As String
Dim searchRange As Range
Dim searchResult As Range
' 検索値を取得
searchText = Range("B3").Value
' 検索範囲を指定
Set searchRange = Range("C:C")
' 検索して結果を取得
Set searchResult = searchRange.Find(what:=searchText, LookIn:=xlValues, lookat:=xlPart)
' 検索結果が見つかった場合、対応するA列の値を取得
If Not searchResult Is Nothing Then
MsgBox Range("A" & searchResult.Row).Value
End If
End Sub
Sub SearchText()
Dim searchText As String
Dim searchRange As Range
Dim searchResult As Range
' 検索値を取得
searchText = Range("B3").Value
' 検索範囲を指定
Set searchRange = Range("C:C")
' 検索して結果を取得
Set searchResult = searchRange.Find(what:=searchText, LookIn:=xlValues, lookat:=xlPart)
' 検索結果が見つかった場合、対応するA列の値を取得
If Not searchResult Is Nothing Then
MsgBox Range("A" & searchResult.Row).Value
End If
End Sub
628デフォルトの名無しさん
2023/04/28(金) 22:05:44.60ID:xyEtsQeE629デフォルトの名無しさん
2023/04/28(金) 22:07:31.25ID:q2nR+ZdU すみません
フォルダの中にあるExcelのファイルを指定のシートのみ残してその他のシートを削除して保存するVBAは組めるでしょうか?
その他にも指定のセルの値をファイル名として保存する方法は可能でしょうか?
フォルダの中にあるExcelのファイルを指定のシートのみ残してその他のシートを削除して保存するVBAは組めるでしょうか?
その他にも指定のセルの値をファイル名として保存する方法は可能でしょうか?
630デフォルトの名無しさん
2023/04/28(金) 22:16:54.88ID:h0I1nwu1 チャジれカス
631デフォルトの名無しさん
2023/04/28(金) 22:45:44.43ID:BEXA+iPo632デフォルトの名無しさん
2023/04/28(金) 23:28:17.83ID:xyEtsQeE >>627
ん?良くみたらこれはmatchの置き換えをしてるだけ?
ん?良くみたらこれはmatchの置き換えをしてるだけ?
633デフォルトの名無しさん
2023/04/28(金) 23:33:05.22ID:q2nR+ZdU >>631
ありがとうございます
ありがとうございます
634デフォルトの名無しさん
2023/04/29(土) 00:11:05.56ID:139vt90Q いつもの否定君息してる~?
635デフォルトの名無しさん
2023/04/29(土) 03:45:20.62ID:+IUP3Yu9 Excel2013でブックやワークシートにコードは貼れますが特定のセルにだけコードを貼って動作させるというような事はできないんでしょうか
コードからセル範囲を指定するというような事しかできない?
コードからセル範囲を指定するというような事しかできない?
■ このスレッドは過去ログ倉庫に格納されています
ニュース
- ミス・ユニバース フィンランド代表の「つり目」写真が波紋… 本人釈明も批判やまず 協会謝罪「徹底的に検証」へ [冬月記者★]
- 自民・麻生太郎副総裁 石破政権の1年は「どよーん」 高市政権発足で「何となく明るくなった」「世の中のことが決まり動いている」★2 [Hitzeschleier★]
- 【おこめ券】鈴木憲和農相 小泉前農相の備蓄米放出を“反省”「備蓄の円滑な運営を図ってまいります」 [Hitzeschleier★]
- 1人3千円の食品高騰対策、何に使える? あいまいなまま衆院通過 [蚤の市★]
- ゆたぼん 二重手術を報告「めちゃくちゃ気に入っています」 [muffin★]
- 【山形】クマ駆除で誤射した猟友会隊員に町が1663万円請求へ...弾当たり男性大けが2023年 小国町 [nita★]
- 中国人、ガチ超正論。「日本人がアイヌに対してやったことを『問題ない』とするなら、中国が日本人に同じことをしても文句ないだろう?」 [314039747]
- 【悲報】新米、全く売れなくて倉庫が満杯になってしまうwwwwwwwwwwwwwwwwwwww [802034645]
- 木曜日のんなっしょい❗(・o・🍬)仕放題スレ🏡
- 【悲報】日本共産党、ツイッター速報にブチギレ法的措置WWWWWWWWWWWWWWWWWWWWWWWWWWWW [935793931]
- 官僚「台湾有事についての質問か、『政府として逐一答えない』と…(カタカタカタ)」高市「私1人で答弁できるわよ!」 [972432215]
- 【悲報】麻生太郎さん、オムツをしていた。晋さん…ここにいたんだね… [731544683]
