Excel VBA質問箱 IV

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

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


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

126 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【79961】別々のシートにある列の結合　VBA

剛 - 18/6/6(水) 21:43 -


	引用なし

	パスワード

こんにちは。よろしくお願いいたします。

題名の件について説明しにくいので，例えて書かせていただきます。

例えば，シート１のＡ列には，１月の予定表，
シート２のＡ列には，２月の予定表，
シート３のＡ列には，３月の予定表・・・・
これが，シート１２まで続いてあるとします。

それらをシート１３にＶＢＡを使って，年間予定表を作成する。
つまり，シート１３のＡ列には１月の予定，Ｂ列には２月の予定・・・Ｌ列には１２月の予定が表示されることになります。

どのような構文になるのでしょうか？

実際には，２００シート分のデータを横並びに結合させなければなりません。ご教授のほどよろしくお願いいたします。

・ツリー全体表示


	【79960】Re:Sendkeysで制御文字と全角文字が送れ...

山田 - 18/6/5(火) 19:29 -


	引用なし

	パスワード

色々とありがとうございました。
Sendmessageを試してみます。

・ツリー全体表示


	【79959】Re:クリックした場所にテキストボックス...

よろずや - 18/6/5(火) 19:13 -


	引用なし

	パスワード

個人用マクロブックに作ってみました。 ThisWorkbook に以下を。 Option Explicit Private Sub Workbook_Open() 　　With Application.CommandBars("Cell").Controls.Add _ 　　　　　　(Type:=msoControlButton, ID:=2950, Temporary:=True) 　　　　.Caption = "テキストボックスの貼り付け" 　　　　.FaceId = 3143 　　　　.OnAction = "テキストボックスの貼り付け" 　　End With End Sub 標準モジュールに以下を。 Option Explicit Sub テキストボックスの貼り付け() 　　With ActiveWindow.RangeSelection 　　　　ActiveSheet.Shapes.AddTextbox _　　　　　　　　 (Orientation:=msoTextOrientationHorizontal _ 　　　　　　　　, Left:=.Left, Top:=.Top, Width:=.Width _ 　　　　　　　　, Height:=.Height).Select 　　End With 　　With Selection.ShapeRange(1).TextFrame2 　　　　.MarginTop = 0 　　　　.MarginBottom = 0 　　　　.MarginRight = 0 　　　　.MarginLeft = 0 　　　　.VerticalAnchor = msoAnchorMiddle 　　　　.HorizontalAnchor = msoAnchorCenter 　　End With End Sub

・ツリー全体表示


	【79958】Re:特定の文字列(6種)の最大値

マナ - 18/6/5(火) 19:09 -


	引用なし

	パスワード

▼chou さん：

>追加の質問をよろしいでしょうか。

理解しないまま、追加要望だしても
余計にわからなくなるだけだと思いますよ。

Sub test2()
　　Dim tbl As Range
　　Dim rng As Range
　　Dim constAreas As Areas
　　Dim blankAreas As Areas
　　Dim r As Range
　　Dim k As Long
　　Dim c As Range
　　
　　Columns(5).Insert
　　
　　Set tbl = Range("A1").CurrentRegion
　　tbl.Columns(5).FormulaR1C1 = "=rc[-2]&""_""&rc[-1]"
　　
　　Set rng = tbl.Columns(6)
　　Set constAreas = rng.SpecialCells(xlCellTypeConstants).Areas
　　Set blankAreas = rng.SpecialCells(xlCellTypeBlanks).Areas
　　
　　Set c = Range("Z1")　'どこか離れた場所を作業用に使用（統合先）
　
　　For Each r In constAreas
　　　　c.Consolidate r.Offset(, -1).Resize(, 2).Address(, , xlR1C1), xlSum, False, True
　　　　c.CurrentRegion.Sort c.Columns(2), xlDescending
　　　　k = k + 1
　　　　If c.Offset(, 1).Value = c.Offset(1, 1).Value Then
　　　　　　MsgBox blankAreas(k).Offset(, -5).Value & "の数字が同じです。"
　　　　Else
　　　　　　blankAreas(k).Offset(, -3).Resize(, 2).Value = Split(c.Value, "_")
　　　　End If
　　　c.CurrentRegion.ClearContents
　　Next
　　
　　Columns(5).Delete

End Sub

・ツリー全体表示


	【79957】Re:特定の文字列(6種)の最大値

chou - 18/6/5(火) 13:35 -


	引用なし

	パスワード

追加の質問をよろしいでしょうか。
列C、Dの間にもう一列追加となり、
CとD列両方を返したい場合です。
空白だった場合ではなく「0ゼロ」だった場合は、
どのようになりますか？
またc列は文字列が含まれる場合があります。

リストは下記の通りです。
　　A　　　B　　C　　D　　E
01　1回目　あ　123　 aaa　　 150　
02　1回目　い　456　 bbb　　 500
03　1回目　う　123　 ccc　　　400
04　1回目　Ａ　0　　　　 0
05　2回目　あ　1M1　 ddd　　 100
06　2回目　Ａ　0　　　　 0
省略
13　本番　あ　123　100
14　本番　い　456　200
15　本番　Ａ　　0　　　　0

と言った具合のリストになった場合です。

C列とD列の組み合わせでEの合計が一番大きいものを検索。
その行と同じCとD列の値をそれぞれのセルに返す。

上記リストの結果が
　　A　　　B　　C　　D　　E
01　1回目　あ　123　 aaa　　 150　
02　1回目　い　456　 bbb　　 500
03　1回目　う　123　 ccc　　　400
04　1回目　Ａ　456　 bbb
05　2回目　あ　1M1　 ddd　　 100
06　2回目　Ａ　1M1　 ddd
省略
13　本番　あ　123　 aaa　100
14　本番　い　456　 bbb　200
15　本番　Ａ　　456　 bbb

午前中に投稿した通り、C列とD列の組み合わせで合計した結果が同じ場合は、
メッセージボックスで警告。
その時にで来れば、◯回目の数字が同じです。」と出したいです。

追加の質問となり、わかりにくく申し訳ありませんが、ご教示ください。
よろしくお願いいたします。

・ツリー全体表示


	【79956】Re:特定の文字列(6種)の最大値

chou - 18/6/5(火) 9:18 -


	引用なし

	パスワード

お返事が遅くなりもうしわけあちません。

γ様回答ありがとうございました。
参考にさせていただきます。
昨日、試していたところですが、
検索対象が1行だけの場合も結果が返りますか？
どうしても0が返ってしまい、調べているところでした。

例えば1回目が2行で、うち1行のB列が「Ａ」だった場合、
もう1行のc列の値が返りますでしょうか？
それとも検索対象が2行以上じゃないとダメでしょうか？

マナ様

ご指摘ありがとうございました。
わたしの例が良くなかったです。
リストの内容として、可能性は低いのですが、
1番が複数あった場合は、msgを出して、あとで直接入力するようにしたいです。
また、検索対象となるＡ以外の値が入っている行は、
1行から複数行、Ａ列の内容も本番のみの場合があります。

説明不足で申し訳ありませんでした。
よろしくお願いいたします。

・ツリー全体表示


	【79955】クリックした場所にテキストボックスを貼...

hy - 18/6/5(火) 8:22 -


	引用なし

	パスワード

エクセルにて、クリックした場所にテキストボックスを貼り付けていきたいのですが、上手くvbaが組めません。どなたか、助けてください。
実際は、エクセル上の任意の場所にクリックするたびに、テキストボックスに数字を入れたものを1～100まで、プロットする必要があり、定期作業のため、効率化を図りたいと考えております。

・ツリー全体表示


	【79954】Re:Sendkeysで制御文字と全角文字が送れ...

亀マスター - 18/6/4(月) 22:30 -


	引用なし

	パスワード

うーむ…ちょっとお手上げかもです。
右クリックメニューで貼り付けがグレーアウトしているということは、あなたが使おうとしている環境では貼り付け操作が禁止されているということですかね…。（一応、貼り付けられるものがクリップボードにない場合もグレーアウトする可能性がありますので、メモ帳などで適当なものをコピーしてから右クリックメニューを開くというのも確認してみてください）。

一応、SendKeysで全角文字を送る際、入力対象となるテキストボックスなりにフォーカスが当たってないと失敗するそうなので、明示的にフォーカスを当ててから実行するとか。（Officeソフト以外のアプリケーションでフォーカスを当てる方法は知らないので、自力でお願いします）
ht tp://madia.world.coocan.jp/vb/vb_bbs2/200301/200301_03010008.html

あと、これも私は使ったことがありませんが、SendMessageやPostMessageという関数もあるようです。

・ツリー全体表示


	【79953】Re:特定の文字列(6種)の最大値

マナ - 18/6/4(月) 22:14 -


	引用なし

	パスワード

▼chou さん：

一番が複数の場合、どれでもよいなら。

本題のセル範囲の指定方法は
γさんのコードをそのまま利用させていただき
最大値を求めるところは、
「統合」と「並べ替え」を使ってみました。

Sub test()
　　Dim rng As Range
　　Dim constAreas As Areas
　　Dim blankAreas As Areas
　　Dim r As Range
　　Dim k As Long
　　Dim c As Range
　
　　Set rng = Range("C1:C15")　 'end等を使って調整のこと
　　Set constAreas = rng.SpecialCells(xlCellTypeConstants).Areas
　　Set blankAreas = rng.SpecialCells(xlCellTypeBlanks).Areas
　　
　　Set c = Range("Z1")　'どこか離れた場所を作業用に使用（統合先）
　　
　　For Each r In constAreas
　　　　c.Consolidate r.Resize(, 2).Address(, , xlR1C1), xlSum, False, True
　　　　c.CurrentRegion.Sort c.Columns(2), xlDescending
　　　　k = k + 1
　　　　blankAreas(k).Value = c.Value
　　　　c.CurrentRegion.ClearContents
　　Next
　
End Sub

・ツリー全体表示


	【79952】Re:特定の文字列(6種)の最大値

マナ - 18/6/4(月) 21:14 -


	引用なし

	パスワード

▼chou さん：

質問です。

>07　3回目　い　456　100
>08　3回目　う　789　500
>09　3回目　え　098　300
>10　3回目　え　098　200
>11　3回目　い　456　400
>12　3回目　Ａ　
　　
>12行目のC列に「456」

>D列にある数値の合計が一番大きくなるC列のコードを、
>B列にある「Ａ」という文字列が入っている行のC列に入力します。

なぜ、「456」でしょうか。
「789」も「098」でも合計は500で同じなのに…

一番が２つ以上の場合のルールを教えてください。

　

・ツリー全体表示


	【79951】Re:Sendkeysで制御文字と全角文字が送れ...

山田 - 18/6/4(月) 20:55 -


	引用なし

	パスワード

右クリックメニューに貼り付けがありますが、グレーアウトしていて選択できないようになっていました。

With CreateObject("Wscript.Shell")で
{TAB}単独、{ENTER}単独で送ってみましたが無反応でした。

・ツリー全体表示


	【79950】Re:エラー処理

hatena - 18/6/4(月) 11:57 -


	引用なし

	パスワード

処理2が一つの命令なら、下記のようにシンプルに記述できます。

Sub aaa()
　　処理1
　　On Error Resume Next
　　処理2
　　If Err <> 0 Then
　　　　処理2'
　　End If
　　On Error GoTo 0
　　処理3
End Sub

・ツリー全体表示


	【79949】Re:エラー処理

hatena - 18/6/4(月) 11:51 -


	引用なし

	パスワード

処理2内でエラーが発生したときのみ、処理2' を実行させたいということなら、

Sub aaa()
　　処理1
　　On Error GoTo ErrProc2
　　処理2
ResumeProc2:
　　On Error GoTo 0
　　処理3

　　Exit Sub
ErrProc2:
　　処理2'
　　GoTo ResumeProc2
End Sub

・ツリー全体表示


	【79948】エラー処理

やまちゃん - 18/6/4(月) 9:27 -


	引用なし

	パスワード

sub aaa()
処理1
On Error GoTo ErrLabel
処理2
処理3

ErrLabel:
　処理2'
end sub()

処理1を実行し、次に処理2でエラーが起きなければ、処理1→処理2→処理3を
エラーが起きれば、処理1→処理2'→処理3となるようにしたいです。
上記のコードでは、うまく実行できなかったのですが、何か抜けているのでしょうか？

・ツリー全体表示


	【79947】Re:特定の文字列(6種)の最大値

γ - 18/6/4(月) 0:21 -


	引用なし

	パスワード

参考になりますか。

Sub testA()
　　Dim rng As Range
　　Dim constAreas As Areas
　　Dim blankAreas As Areas
　　Dim r As Range
　　Dim k As Long
　　
　　Set rng = Range("C1:C15")　 'end等を使って調整のこと
　　Set constAreas = rng.SpecialCells(xlCellTypeConstants).Areas
　　Set blankAreas = rng.SpecialCells(xlCellTypeBlanks).Areas
　　
　　For Each r In constAreas
　　　　k = k + 1
　　　　blankAreas(k).Value = WorksheetFunction.Max(r)
　　Next
　　
End Sub

・ツリー全体表示


	【79946】特定の文字列(6種)の最大値

chou - 18/6/3(日) 23:49 -


	引用なし

	パスワード

あるリストを指定のフォーマットに変換するマクロを組んでいます。
その中で、ある文字列と同じ文字列に入っている最大値を探し出し、
その文字列に紐付くコードを転記する作業をするのに、どのようにしたら良いか、
ご教示いただけますでしょうか。

リストは下記の通りです。
　　A　　　B　　C　　D
01　1回目　あ　123　100　
02　1回目　い　456　200
03　1回目　う　789　300
04　1回目　Ａ　
05　2回目　あ　123　100
06　2回目　Ａ　
07　3回目　い　456　100
08　3回目　う　789　500
09　3回目　え　098　300
10　3回目　え　098　200
11　3回目　い　456　400
12　3回目　Ａ　
13　本番　あ　123　100
14　本番　い　456　200
15　本番　Ａ　　　

結果は、
04行目のC列に「789」
06行目のC列に「123」
12行目のC列に「456」
15行目のC列に「456」が入るようにしたいです。

B列にある同じ文字列のなかから、
D列にある数値の合計が一番大きくなるC列のコードを、
B列にある「Ａ」という文字列が入っている行のC列に入力します。

どうしていいかわからないのは、
最大値を探すセル範囲の指定方法です。
宜しくお願いします。

・ツリー全体表示


	【79945】Re:画像付データベース

そば - 18/5/31(木) 22:50 -


	引用なし

	パスワード

▼亀マスターさん：

ご回答ありがとうございます！
亀マスターさんがアドバイスしてくれたような機能が実装できれば、
わたしの希望しているような動きになりそうです。

しかし今の自分には、なかなかレベルが高そうです。
でももう少し自分で努力してみようと思います。

そこでまたつまづいたら質問させてください。
よろしくお願いします。

・ツリー全体表示


	【79944】Re:Sendkeysで制御文字と全角文字が送れ...

亀マスター - 18/5/31(木) 18:57 -


	引用なし

	パスワード

貼り付けができませんか…。
ショートカットキーでの貼り付け以外でだと、右クリックメニューからの貼り付けなどどうでしょうか。
右クリックメニューはShift＋F10で出せますので、これを送った後、括弧書きで書かれている貼り付けに対応するキーを押すということで。
例えば、メモ帳だと右クリックすると「貼り付け(P)」と表示されるかと思いますが、この「P」を入力することで貼り付けができます。それをSendKeysで再現しようというわけです。
対象のアプリケーションで入力中に右クリックをしてみて、どのキーが貼り付けに対応しているかを確認してみてください。

Tabに関してはちょっと対応方法が思いつかないですが、Tabの前に他のキーを連続して押していませんか？SendKeysは連続で使うとアプリケーション側が反応する前に次のキーを送信してしまうことがあるので、試しにひとつのキーを送信する度にSleepか何かで時間を空けてみてはどうでしょう。

あと、VBAのSendKeysではなく、ShellスクリプトのSendKeysも試してみてはどうでしょうか。VBAではうまくいかなくても、Shellならうまくいくということもあるようです。ShellのSendKeysは
With CreateObject("Wscript.Shell")
　　.SendKeys "A"
End With
のような感じで使えます。

・ツリー全体表示


	【79943】Re:セルにある日付をファイル名に反映

よろずや - 18/5/30(水) 23:29 -


	引用なし

	パスワード

▼いちさん：
>▼よろずやさん：
>>▼いちさん：
>>>色々調べては見たものの、見当がつかず手付かずです･･･
>>ファイル名の変更は保存するときにしか出来ないということは理解しておられますか？
>>
>>1. セルから月を取り出す。
>>2. 自ブックのファイル名を取り出す。
>>3. 1.と2.を結合する。
>>4. ファイル名を変更して保存する。
>>
>>4.は出来ますか？
>
>はい。大丈夫です。
じゃぁ、手付かずと言うほどでもないですね。
そこに、追加していきましょう。
myMonth = Format(Range("A1").Value, "mm")
myPath = ThisWorkbook.Path
myName = ThisWorkbook.Name
ここまで出来たら見せてください。

>ちなみにファイル名を変更しつつ上書き保存というのは出来ますでしょうか？
別名で保存すれば別ファイルになります。

・ツリー全体表示


	【79942】Re:Sendkeysで制御文字と全角文字が送れ...

山田 - 18/5/30(水) 23:11 -


	引用なし

	パスワード

返信ありがとうございます。

メモ帳には貼り付けできています。
アプリケーションに貼り付けのショートカットキーがあるかどうかはわかっていません。
ないかもしれません。

複数のテキストボックスがあり、１つに入力を終えるとTABキーを押して次のテキストボックスに移って入力をしています。
それと同じことしたくて、TABキーを送ろうとしています。

言葉がたらずすいません。

・ツリー全体表示


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

126 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free