Excel VBA質問箱 IV

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

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


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

32 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【81847】素人ですいません

papa - 21/6/25(金) 9:59 -


	引用なし

	パスワード

Windows10 Office2019の環境で
売上集計表から、B列のある売上日をダブルクリックでその行のデータの「顧客名」C列「適応」D列「金額」E列を領収書(別ブック)を開き、領収書(別ブック)のB7に顧客名 C11に金額 D16に適応を転記売上集計表のブックを閉じる

このような事を実現したいのですか゛
どちら様かご指南くださいよろしくお願いします。

・ツリー全体表示


	【81846】Re:素人ですいません

papa - 21/6/24(木) 12:11 -


	引用なし

	パスワード

▼山内さん：
>選択ではなくフォーカスする場合フォームコントロールではなくActiveXコントロールじゃないとダメみたいなので注意

ありがとうございました
>ActiveXコントロールじゃないとダメみたいなので注意
動かなかった原因です

フォームコントロールで実行していました

感謝です　実現できました

・ツリー全体表示


	【81845】Re:素人ですいません

山内 - 21/6/24(木) 10:16 -


	引用なし

	パスワード

選択ではなくフォーカスする場合フォームコントロールではなくActiveXコントロールじゃないとダメみたいなので注意

'標準モジュール
Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
Function testkey() As Boolean 'エンターキーが押されたか判定する関数
　　Const keypressed = -32768
　　testkey = (GetAsyncKeyState(vbKeyReturn) And keypressed) = keypressed
End Function
Sub testmove() 'ボタンをフォーカスする
　　Worksheets("Sheet1").CommandButton1.Activate
End Sub
Sub testmsg() 'ボタンを押したときに実行するマクロ
　　MsgBox "成功"
End Sub

'ワークシートイベント
Private Sub CommandButton1_Click() 'ボタンをクリックしたときのイベント
　　Call testmsg
End Sub

Private Sub CommandButton1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'ボタンをフォーカス中にキーを離したときのイベント
　　If KeyAscii = vbKeyReturn Then
　　　　CommandButton1_Click
　　End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'ワークシートの値を変えたときのイベント
　　If Target = Worksheets("Sheet1").Range("A1") Then
　　　　If testkey Then
　　　　　　Call testmove
　　　　End If
　　End If
End Sub

・ツリー全体表示


	【81844】Re:セル内の文字色操作

こまおじ - 21/6/24(木) 0:51 -


	引用なし

	パスワード

お礼が遅れて申し訳ありません。

わざわざ時間を割いて検証いただきまして、
ありがとうございました。

・ツリー全体表示


	【81843】素人ですいません

papa - 21/6/23(水) 21:39 -


	引用なし

	パスワード

只今　勉強中で　色々検索しながら組み立てています

Office2019 Windows10 の環境で
セルの例えばA1に値を入れエンターキーを押すとシート上に作成されたボタンがアクティブになりエンターキーを押すとボタンに設定されたマクロが実行される

このような事を実現させたいのですが

ご指南お願いいたします

・ツリー全体表示


	【81842】Re:次の列に続けて同じ処理を繰り返す方法

山内 - 21/6/23(水) 13:28 -


	引用なし

	パスワード

やり方は色々あると思いますけど
シート1.のB列の最初の行から最終行までの値をIfやSelect caseで判別して
シート1.のA列とB列をシート2.にコピーしていけばいいのではないでしょうか

for next
if(もしくはselect caseなど)
あとは最終行の取得方法とかを調べるとできると思います。

・ツリー全体表示


	【81841】次の列に続けて同じ処理を繰り返す方法

VBA初心者コウ - 21/6/22(火) 19:19 -


	引用なし

	パスワード

こんにちは。VBA超初心者です。

仕事でお客様の予約表を作成したいと思っています。
印刷の都合上、同じ時間枠を2列(5行×2列)で表を作成しています。
この場合、シート①に10行で書かれているお名前を、シート②の5行×2列の表のセルにどのようにして当て込めば良いかをご教示いただきたいです。
例えば8名が12時に10名が13時に予約していたり、日により予約の人の数は変動します。
そのため、12時の5行×2列に8名、13時の5行2列に10名と変動に対応して当て込めたいと考えています。
シート①の数の変動に対応しつつ、シート②の表に列に処理を繰り返すためにはどの様にしたらよろしいのでしょうか。

例えばシート①に
A列に予約時間(12時、13時など)
B列にお名前(Zさん、Yさん、Xさん、…など)
が入力されているとして、
シート②の
A1に12時（B1とセル結合）
C1に13時（D1とセル結合）
と記載された表の
A2:B6までに12時予約の人の名前
C2:D6までに13時予約の人の名前
を入れる方法を教えていただけますと大変助かります。

分かりにくくて申し訳ございませんがどなたかよろしくお願いします。

・ツリー全体表示


	【81840】Re:セル内の文字色操作

マナ - 21/6/21(月) 21:59 -


	引用なし

	パスワード

▼こまおじさん：

>１～２文字目が斜体、取り消し線設定などされていると、
>書式情報が壊れてしまう感じですね。

さすがに、それは確認済みというか、承知のうえの回答でしたが…

ただ全文字で再設定する必要ないというのは、
ご指摘の通りで、これに関しては、全く考えていませんでした。

・ツリー全体表示


	【81839】Re:セル内の文字色操作

こまおじ - 21/6/21(月) 2:03 -


	引用なし

	パスワード

▼マナさん

丁寧に解説していただきありがとうございます。
教えていただいた方式だと、
１～２文字目が斜体、取り消し線設定などされていると、
書式情報が壊れてしまう感じですね。

連続文字の際の方、ご指摘ありがとうございます。
検証が足りてませんでした。
連続して斜体になっている文字の検証をしてみたのですが、
結果として、連続文字として処理すればよいことが分かりました。
コードを以下に載せておきます。

ご助言ありがとうございました。
--------------------------------------------------------------
'連続文字かを判定
For 終端 = 2 To Len(Cells(行, 列))
　If Cells(行, 列).Characters(1, 1).Font.Name = Cells(行, 列).Characters(終端, 1).Font.Name And _
　　Cells(行, 列).Characters(1, 1).Font.FontStyle = Cells(行, 列).Characters(終端, 1).Font.FontStyle And _
　　Cells(行, 列).Characters(1, 1).Font.Size = Cells(行, 列).Characters(終端, 1).Font.Size And _
　　Cells(行, 列).Characters(1, 1).Font.Strikethrough = Cells(行, 列).Characters(終端, 1).Font.Strikethrough And _
　　Cells(行, 列).Characters(1, 1).Font.OutlineFont = Cells(行, 列).Characters(終端, 1).Font.OutlineFont And _
　　Cells(行, 列).Characters(1, 1).Font.Shadow = Cells(行, 列).Characters(終端, 1).Font.Shadow And _
　　Cells(行, 列).Characters(1, 1).Font.Underline = Cells(行, 列).Characters(終端, 1).Font.Underline And _
　　Cells(行, 列).Characters(1, 1).Font.ColorIndex = Cells(行, 列).Characters(終端, 1).Font.ColorIndex And _
　　Cells(行, 列).Characters(1, 1).Font.TintAndShade = Cells(行, 列).Characters(終端, 1).Font.TintAndShade And _
　　Cells(行, 列).Characters(1, 1).Font.ThemeFont = Cells(行, 列).Characters(終端, 1).Font.ThemeFont Then
　Else
　　Exit For
　End If
Next
'
If 終端 > Len(Cells(行, 列)) Then
　文字長 = 1
Else
　文字長 = 終端 - 1
End If

'RangeのFontプロパティを上書き。Characters(1, 連続文字長)の情報を更新するとなぜか更新される。
With Cells(行, 列).Characters(1, 文字長).Font
　　.Name = Cells(行, 列).Characters(1, 文字長).Font.Name
　　.FontStyle = Cells(行, 列).Characters(1, 文字長).Font.FontStyle
　　.Size = Cells(行, 列).Characters(1, 文字長).Font.Size
　　.Strikethrough = Cells(行, 列).Characters(1, 文字長).Font.Strikethrough
　　.OutlineFont = Cells(行, 列).Characters(1, 文字長).Font.OutlineFont
　　.Shadow = Cells(行, 列).Characters(1, 文字長).Font.Shadow
　　.Underline = Cells(行, 列).Characters(1, 文字長).Font.Underline
　　.ColorIndex = Cells(行, 列).Characters(1, 文字長).Font.ColorIndex
　　.TintAndShade = Cells(行, 列).Characters(1, 文字長).Font.TintAndShade
　　.ThemeFont = Cells(行, 列).Characters(1, 文字長).Font.ThemeFont
End With

'NULLがあるため、入れ子ではなく独立して条件の確認を行う。
If Cells(行, 列).Characters(1, 文字長).Font.Superscript = True Then
　Cells(行, 列).Characters(1, 文字長).Font.Superscript = Cells(行, 列).Characters(1, 文字長).Font.Superscript
End If
'NULLがあるため、入れ子ではなく独立して条件の確認を行う。
If Cells(行, 列).Characters(1, 文字長).Font.Subscript = True Then
　Cells(行, 列).Characters(1, 文字長).Font.Subscript = Cells(行, 列).Characters(1, 文字長).Font.Subscript
End If

'斜体文字チェック→赤文字設定
For 開始文字位置 = 1 To Len(セル)
　If Cells(行, 列).Characters(開始文字位置, 1).Font.Italic = True Then
　　Cells(行, 列).Characters(開始文字位置, 1).Font.ColorIndex = 3
　End If
Next

・ツリー全体表示


	【81838】Re:セル内の文字色操作

マナ - 21/6/20(日) 19:05 -


	引用なし

	パスワード

▼こまおじさん：

この行は不要でした。

>　　　　　　c.Characters(i, 0).Font.Bold = Not ary(i, 2)

・ツリー全体表示


	【81837】Re:セル内の文字色操作

マナ - 21/6/20(日) 17:41 -


	引用なし

	パスワード

▼こまおじさん：

頂いたコメントをヒントに考えてみました
地道に全文字設定し直せばOKのようです。

Sub test()
　　Dim i As Long, ary() As Boolean
　　Dim c As Range
　　
　　Set c = Range("A1")
　　ReDim ary(1 To Len(c.Characters.Text), 1 To Len(c.Characters.Text))

　　For i = 1 To UBound(ary)
　　　　ary(i, 1) = c.Characters(i, 1).Font.Italic
　　　　ary(i, 2) = c.Characters(i, 1).Font.Bold
　　Next i
　　
　　For i = 1 To UBound(ary)
　　　　With c.Characters(i, 1)
　　　　　　c.Characters(i, 0).Font.Bold = Not ary(i, 2)
　　　　　　.Font.Italic = ary(i, 1)
　　　　　　.Font.Bold = ary(i, 2)
　　　　End With
　　Next i
　　
　　For i = 1 To UBound(ary)
　　　　With c.Characters(i, 1)
　　　　　　If ary(i, 1) Then
　　　　　　　　.Font.Color = vbRed
　　　　　　　　.Font.Italic = ary(i, 1)
　　　　　　End If
　　　　End With
　　Next i
　　
End Sub

・ツリー全体表示


	【81836】Re:セル内の文字色操作

マナ - 21/6/20(日) 12:21 -


	引用なし

	パスワード

▼こまおじさん：

研究熱心ですね、
１文字目から連続して斜体の場合は失敗するようですが…

・ツリー全体表示


	【81835】Re:セル内の文字色操作

こまおじ - 21/6/20(日) 9:54 -


	引用なし

	パスワード

情報提供ありがとうございます。
おかげさまで、VBAのバグということがわかり、
ロジックがまずい訳ではないと分かり助かりました。
そこで、解決方法より回避方法を模索し、
どうやら、回避出来ました。

原因はよくわからないままですが、
リボン上に現れるセルのフォント情報と、
セル内の１文字目のフォント情報が乖離している場合に、
このバグは発生するみたいです。
もう少し、VBAよりに書くと、
Range.Fontのプロパティと
Range.Characters(1, 1).Fontのプロパティの全てが一致していない場合に、
マクロ実行でRange.Characters(1以外, 1).Fontのプロパティの一部をいじると
セル内の書式情報が壊れます。

では、RangeとRange.Characters(1, 1)の情報を合わせればいいと考えるも、
VBA実行時にRange.Characters(1, 1)の情報を退避してから、
Range.Fontのプロパティ情報でプロパティに上書きし、
最後に退避した情報で元に戻してやればいいかと考えたのですが、
Range.FontのプロパティがNULLの場合(フォントサイズ等でありえます)、
データが上書きできずバグります。

詰んだかと思ったんですが、もうひとつのVBAのバグ(仕様？)があり、
Fontの情報を揃えることが出来ました。
やりかたは簡単で、Range.Characters(1, 1).Fontのプロパティを
Range.Characters(1, 1).Fontのプロパティで自身の情報で上書きすると、
Range.Fontのプロパティが自動的に同期をとります。
ただし、文字の上位置と下位置のプロパティは、
どちらか一方しか成り立ちませんので条件分岐が必要になります。

以下、解決したコードを載せておきます。

'RangeのFontプロパティを上書き。Characters(1, 1)の情報を更新するとなぜか更新される。
With Cells(対象行, 対象列).Characters(1, 1).Font
　.Name = Cells(対象行, 対象列).Characters(1, 1).Font.Name
　.FontStyle = Cells(対象行, 対象列).Characters(1, 1).Font.FontStyle
　.Size = Cells(対象行, 対象列).Characters(1, 1).Font.Size
　.Strikethrough = Cells(対象行, 対象列).Characters(1, 1).Font.Strikethrough
　.OutlineFont = Cells(対象行, 対象列).Characters(1, 1).Font.OutlineFont
　.Shadow = Cells(対象行, 対象列).Characters(1, 1).Font.Shadow
　.Underline = Cells(対象行, 対象列).Characters(1, 1).Font.Underline
　.ColorIndex = Cells(対象行, 対象列).Characters(1, 1).Font.ColorIndex
　.TintAndShade = Cells(対象行, 対象列).Characters(1, 1).Font.TintAndShade
　.ThemeFont = Cells(対象行, 対象列).Characters(1, 1).Font.ThemeFont
End With

'NULLがあるため、入れ子ではなく独立して条件の確認を行う。
If Cells(対象行, 対象列).Characters(1, 1).Font.Superscript = True Then
　Cells(対象行, 対象列).Characters(1, 1).Font.Superscript = Cells(対象行, 対象列).Characters(1, 1).Font.Superscript
End If

'NULLがあるため、入れ子ではなく独立して条件の確認を行う。
If Cells(対象行, 対象列).Characters(1, 1).Font.Subscript = True Then
　Cells(対象行, 対象列).Characters(1, 1).Font.Subscript = Cells(対象行, 対象列).Characters(1, 1).Font.Subscript
End If

'斜体文字チェック→赤文字設定
For 開始文字位置 = 1 To Len(対象セル)
　If Cells(対象行, 対象列).Characters(開始文字位置, 1).Font.Italic = True Then
　　Cells(対象行, 対象列).Characters(開始文字位置, 1).Font.ColorIndex = 3
　End If
Next

・ツリー全体表示


	【81834】Re:セル内の文字色操作

マナ - 21/6/19(土) 16:03 -


	引用なし

	パスワード

▼こまおじさん：

ワードを使ってみました。
１）ワードにコピペ
２）置換で文字色変更
３）エクセルにコピペ

ただこの方法にも以下の問題があります。
・セル内改行があるとだめ
・時間がかかる

・ツリー全体表示


	【81833】Re:セル内の文字色操作

マナ - 21/6/19(土) 14:28 -


	引用なし

	パスワード

▼こまおじさん：

他板ですが、つい先日同様の質問がありました
ただ完全解決ではありません
ht tp://www.excel.studio-kazu.jp/kw/20210616111834.html

・ツリー全体表示


	【81832】セル内の文字色操作

こまおじ - 21/6/19(土) 5:30 -


	引用なし

	パスワード

教えてください。

セル内の文字が斜体だった場合にのみ、
赤色にするコードを作成したのですが、
先頭文字が斜体で、かつ、ほかの文字が斜体だった場合に、
書式情報が壊れてしまう状態になります。
※セル全体が斜体文字の場合は書式は正常のままです。
具体的な文字列を記載しますと
「１２３４５６７８９」
で「１と３」や「１と９」の状態だと書式情報が壊れます。

これはvba上のバグなのでしょうか？
回避策などがありましたら、教えてください。

以下が作成したコードです。
※対象のセルのアドレスは1，1となっていますが、
　実際は変数でループ処理にしています。

For 開始位置 = 1 To Len(Cells(1, 1))
　If Cells(1, 1).Characters(開始位置, 1).Font.Italic = True Then
　　Cells(1, 1).Characters(開始位置, 1).Font.ColorIndex = 3
　End If
Next

・ツリー全体表示


	【81831】Re:dictionaryの使い方で質問（その２）

煮詰まった - 21/6/18(金) 9:24 -


	引用なし

	パスワード

▼マナさん：
>▼煮詰まったさん：
>
>If myDic.Exists(Keyval) Then
>
>では？

この記述で対応することができることわかりました。
ありがとうございました。

・ツリー全体表示


	【81830】Re:dictionaryの使い方で質問（その２）

煮詰まった - 21/6/18(金) 9:18 -


	引用なし

	パスワード

▼マナさん：

　　　　For m = 1 To UBound(c1)　'検索用配列の要素数分ループ
　　　　

　　　　　　Keyval = c1(m, 1)
　　　　　　''myDic(Keyval) = ItemVal

　　　　　　　 c1(m, 2) = myDic.Item(Keyval)(0)　'検索値のKeyでItemを抽出
　　　　　　　 c1(m, 3) = myDic.Item(Keyval)(1)　'検索値のKeyでItemを抽出
　　　　
　　　　　　''End If
　　　　
　　　　Next m

　　　　いろいろ説明ありがとうございました。
　　　　　
　　　　上記の処理で元に商品キーはあるが先に商品キーがない場合
　　　　型が一致しないのエラーがでるのでこの回避方法教えてください。

・ツリー全体表示


	【81829】Re:dictionaryの使い方で質問（その２）

マナ - 21/6/17(木) 22:55 -


	引用なし

	パスワード

▼煮詰まったさん：

dictionaryには行番号を登録するのもありと思います。

Sub test()
　　Dim dic As Object
　　Dim r1 As Range, r2 As Range
　　Dim v1, v2
　　Dim k As Long, n As Long
　　
　　Set dic = CreateObject("scripting.dictionary")
　　
　　With Workbooks("サンプル２.xlsm")
　　　　Set r1 = .Sheets("元").Range("A1:C9")
　　　　Set r2 = .Sheets("先").Range("A1:C9")
　　End With
　　
　　v1 = r1.Value
　　v2 = r2.Value

　　For k = 1 To UBound(v2)
　　　　dic(v2(k, 1)) = k
　　Next
　　
　　For k = 1 To UBound(v1)
　　　　If dic.exists(v1(k, 1)) Then
　　　　　　n = dic(v1(k, 1))
　　　　　　v1(k, 2) = v2(n, 2)
　　　　　　v1(k, 3) = v2(n, 3)
　　　　End If
　　Next
　
　　r1.Value = v1

End Sub

・ツリー全体表示


	【81828】Re:dictionaryの使い方で質問（その２）

マナ - 21/6/17(木) 22:32 -


	引用なし

	パスワード

▼煮詰まったさん：

>　　　　　　If Not myDic.Exists(Keyval) Then　　　　　
>　　　　　　　　myDic.Add Keyval, ItemVal　　　　　　　
>　　　　　　End If

こうすれば、重複キーでもエラーにならなので
１行でOKです。

myDic(Keyval) = ItemVal

>

・ツリー全体表示


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

32 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free