Excel VBA質問箱 IV

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

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


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

33 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


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

マナ - 21/6/17(木) 21:30 -


	引用なし

	パスワード

▼煮詰まったさん：

If myDic.Exists(Keyval) Then

では？

・ツリー全体表示


	【81825】dictionaryの使い方で質問（その２）

煮詰まった - 21/6/17(木) 18:54 -


	引用なし

	パスワード

元シートは以下
商品名
a1
a2
a3
a4
a5

先シートは以下
商品名　　　　価格　　　　価格2
a2　　　　100　　　　200
a3　　　　110　　　　220
a4　　　　120　　　　240

元シートに先シートの商品名をキーに価格、価格２を取り込もうとした場合に

元シートに商品名のキーはあるが
先シートに商品名のキーがない場合の回避方法教えてください。

　　　 For m = 1 To UBound(c1)　'検索用配列の要素数分ループ
　　　　
　　　　　
　　　　　　Keyval = c1(m, 1)
　　　　　　
　　　　　　　 c1(m, 2) = myDic.Item(Keyval)(0)　'検索値のKeyでItemを抽出
　　　　　　　 c1(m, 3) = myDic.Item(Keyval)(1)　'検索値のKeyでItemを抽出
　　　　
　　　　　　　ここにで元シートに商品キーがあるが先シートに商品
　　　　　　　キーがない場合を教えてください。　　　　
　　　　Next m

Sub Sample2()

　　　　
　　　　Dim c1 As Variant
　　　　Dim c2 As Variant
　　　　
　　　　
　　　　Dim Keyval　　　As String
　　　　Dim ItemVal　　 As Variant
　　　　Dim ItemVal1　　 As String
　　　　Dim ItemVal2　　 As String
　　　　
　　　　Dim MaxRow　　　As Long
　　　　Dim n　　　　　 As Long
　　　　Dim m　　　　　 As Long
　　　　
　　　　Dim myDic　　　 As Object

　　　　Windows("サンプル２.xlsm").Activate
　　　　Sheets("元").Select
　　　　Range("A1").Select
　　　　c1 = Range("A1:C9")

　　　　
　　　　Windows("サンプル２.xlsm").Activate
　　　　Sheets("先").Select
　　　　Range("A1").Select
　　　　c2 = Range("A1:C9")

　　　　Set myDic = CreateObject("Scripting.Dictionary")
　　　　
　　　　For n = 1 To UBound(c2) '参照用の配列を要素数分ループ
　　　　　　　　　　　　　　
　　　　　　Keyval = c2(n, 1) '3.Keyを格納
　　　　　　ItemVal1 = c2(n, 2) '4.Itemを格納
　　　　　　ItemVal2 = c2(n, 3) '4.Itemを格納
　　　　　　
　　　　　　ItemVal = Array(ItemVal1, ItemVal2)
　　　　　　
　　　　　　
　　　　　　'登録されていなければ登録
　　　　　　'※Dictionaryは重複登録出来ない
　　　　　　'今回のサンプルデータは初めから重複はありません。
　　　　　　If Not myDic.Exists(Keyval) Then
　　　　　　
　　　　　　　　myDic.Add Keyval, ItemVal
　　　　　　　　
　　　　　　End If
　　　　　　
　　　　Next n
　　　　
　　　　For m = 1 To UBound(c1)　'検索用配列の要素数分ループ
　　　　
　　　　　
　　　　　　Keyval = c1(m, 1)
　　　　　　
　　　　　　　 c1(m, 2) = myDic.Item(Keyval)(0)　'検索値のKeyでItemを抽出
　　　　　　　 c1(m, 3) = myDic.Item(Keyval)(1)　'検索値のKeyでItemを抽出
　　　　
　　　　
　　　　Next m
　　　　
　　　　
　　　　Windows("サンプル２.xlsm").Activate
　　　　Sheets("元").Select
　　　　Range("A1").Select
　　　　Range("A1:C9") = c1
　　　　
　　　　
　　　　Set myDic = Nothing
　　　　
　　　　Set c1 = Nothing
　　　　Set c2 = Nothing
　　　　
　　
　　End Sub

・ツリー全体表示


	【81824】Re:dictionaryの使い方での質問

煮詰まった - 21/6/17(木) 14:39 -


	引用なし

	パスワード

▼山内さん：
>myDic.Item("A1") ≒ Array("10","100")なんだから
>.Cells(i + 1, 2).Value = myDic.Item(vKey)(0)
>.Cells(i + 1, 3).Value = myDic.Item(vKey)(1)
>でいいんじゃない？
>
>.Cells(i + 1, 2).Resize(, 2).Value = myDic.Item(vKey)
>とかでも出ると思うけど

ご指摘の通しで対応できました。
ありがとうございました。

・ツリー全体表示


	【81823】Re:dictionaryの使い方での質問

山内 - 21/6/17(木) 13:13 -


	引用なし

	パスワード

myDic.Item("A1") ≒ Array("10","100")なんだから
.Cells(i + 1, 2).Value = myDic.Item(vKey)(0)
.Cells(i + 1, 3).Value = myDic.Item(vKey)(1)
でいいんじゃない？

.Cells(i + 1, 2).Resize(, 2).Value = myDic.Item(vKey)
とかでも出ると思うけど

・ツリー全体表示


	【81822】dictionaryの使い方での質問

煮詰まった - 21/6/17(木) 11:31 -


	引用なし

	パスワード

教えてください。

文字　　　　数量１　　　　数量２
A1　　　　10　　　　100
A1　　　　20　　　　200
B1　　　　30　　　　300
B1　　　　40　　　　400
B2　　　　50　　　　500
B2　　　　60　　　　600
A2　　　　70　　　　700
A2　　　　80　　　　800

sheet1に上の表があり文字が重複していないデータの文字から数量２までを
sheet2に抽出しようとしています。
文字重複はdictionaryで対応でき数量１はとりだせましたが、数量２がうまく
取り出せません。
この取り出し方どなたか教えてください。
初心者なのでわかりやすく説明頂けると助かります。
dictionaryへのセットは理解できましたが取り出し方がわかりません。
特にsheet2に出力する際のmyDic.Item(vKey)がいまいちわからないです

お願いします。

Sub sample3()

　　Dim myDic As New Dictionary
　　Dim i As Long
　　
　　Dim vals　　　　As Variant
　　Dim ovals　　　　As Variant
　　
　　Dim a1　　　　　As String
　　Dim a2　　　　　As String
　　Dim a3　　　　　As String
　　
　　With Worksheets("Sheet1")
　　　　For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
　　　　　　If Not myDic.Exists(.Cells(i, 1).Value) Then
　　　　　　　　
　　　　　　　　　 a1 = .Cells(i, 1).Value
　　　　　　　　　 a2 = .Cells(i, 2).Value
　　　　　　　　　 a3 = .Cells(i, 3).Value
　　　　　　　　
　　　　　　　　　 vals = Array(a2, a3)
　　　　　　　　　　　　　
　　　　　　　　''myDic.Add .Cells(i, 1).Value, .Cells(i, 2).Value
　　　　　　　　myDic.Add a1, vals
　　　　　　　　
　　　　　　End If
　　　　Next i
　　End With
　
　　Dim vKey As Variant
　　With Worksheets("Sheet2")
　　　　i = 0
　　　　For Each vKey In myDic
　　　　　　i = i + 1
　　　　　　
　　　　　　
　　　　　　.Cells(i + 1, 1).Value = vKey
　　　　　　.Cells(i + 1, 2).Value = myDic.Item(vKey)
　　　　　　.Cells(i + 1, 3).Value = myDic.Item(1)
　　　　　　
　　　　　　
　　　　Next
　　End With
　　Set myDic = Nothing
End Sub

・ツリー全体表示


	【81821】Re:メディアの作成日時の取得方法について

マナ - 21/6/11(金) 21:21 -


	引用なし

	パスワード

▼K さん：

全く興味ないので、試していません。
ht tps://excel-ubara.com/excelvba4/EXCEL_VBA_426.html

・ツリー全体表示


	【81820】メディアの作成日時の取得方法について

K - 21/6/6(日) 0:13 -


	引用なし

	パスワード

画像と動画のファイルをコピーしてファイル名に撮影日をつけるマクロを作成中しているのですが、画像ファイルはExtendedProperty("System.Photo.DateMade")で撮影日を取得できたのですが、動画ファイルは撮影日に情報ががなく、メディアの作成日に情報が入っています。

この場合、ExtendedPropertyでメディアの作成日時を取得する方法があれば教えていただけますでしょうか。

・ツリー全体表示


	【81819】Re:選択したシェイプがグループに属して...

おもち - 21/6/3(木) 13:18 -


	引用なし

	パスワード

▼通りすがりさん：
質問内容等で分かりにくい部分があり失礼しました。

ご教示いただいた内容を使用して無事に解決しました。
誠にありがとうございました。

・ツリー全体表示


	【81818】Re:選択したシェイプがグループに属して...

おもち - 21/6/2(水) 17:55 -


	引用なし

	パスワード

▼通りすがりさん：
>エラー処理を使った方法です。
>
>Sub test()
> Dim spname As String
> Dim gpname As String
>　spname = "正方形/長方形 3"
>　Err.Clear
>　On Error Resume Next
>　gpname = ActiveSheet.Shapes(spname).ParentGroup.Name
>　If Err.Number = 0 Then
>　　 MsgBox spname & "はグループ化されています。"
>　Else
>　　MsgBox spname & "はグループ化されていません。"
>　End If
>　On Error GoTo 0
>End Sub

お時間割いていただきありがとうございます。
エラー処理は思いつきませんでした。
明日、早速試させていただきます。
取り急ぎ、お礼とさせていただきます。

・ツリー全体表示


	【81817】Re:選択したシェイプがグループに属して...

通りすがり - 21/6/2(水) 17:35 -


	引用なし

	パスワード

エラー処理を使った方法です。

Sub test()
Dim spname As String
Dim gpname As String
　spname = "正方形/長方形 3"
　Err.Clear
　On Error Resume Next
　gpname = ActiveSheet.Shapes(spname).ParentGroup.Name
　If Err.Number = 0 Then
　　 MsgBox spname & "はグループ化されています。"
　Else
　　MsgBox spname & "はグループ化されていません。"
　End If
　On Error GoTo 0
End Sub

・ツリー全体表示


	【81816】Re:選択したシェイプがグループに属して...

通りすがり - 21/6/2(水) 17:25 -


	引用なし

	パスワード

私の回答は勘違いかもしれません。
保留でお願いします。

・ツリー全体表示


	【81815】Re:選択したシェイプがグループに属して...

通りすがり - 21/6/2(水) 17:04 -


	引用なし

	パスワード

少し改造するだけでできましたが？
試したうえで回答しています。
少しはご自分で試行錯誤しましたか？

・ツリー全体表示


	【81814】Re:選択したシェイプがグループに属して...

おもち - 21/6/2(水) 16:53 -


	引用なし

	パスワード

▼通りすがりさん：
>参考HPです。
>
>ht　tps://www.relief.jp/docs/excel-vba-determine-selected-shape-within-a-group.html

返信ありがとうございます。
ですが、やりたいことが異なります。

参考HPでは、.typeを使用して今選択しているシェイプがグループかどうかを判定しているのですが、やりたいことは選択するのは必ず個別のシェイプで、そのシェイプがグループに属しているかです。
他にご意見ありましたら宜しくお願いします。

・ツリー全体表示


	【81813】Re:選択したシェイプがグループに属して...

通りすがり - 21/6/2(水) 16:29 -


	引用なし

	パスワード

参考HPです。

ht　tps://www.relief.jp/docs/excel-vba-determine-selected-shape-within-a-group.html

・ツリー全体表示


	【81812】選択したシェイプがグループに属している...

おもち - 21/6/1(火) 22:11 -


	引用なし

	パスワード

初めまして。

特定のシェイプを選択して、そのシェイプがグループに属しているかどうかで処理を分岐させたいです。

グループに属していれば、.parentgroupというプロパティに情報が保存されるのはわかったのですが、この情報の有無を判断するにはどのように記述したら良いか教えていただけないでしょうか。
宜しくお願いします、

・ツリー全体表示


	【81811】Re:textについて

とうした - 21/6/1(火) 11:06 -


	引用なし

	パスワード

>山内さん
お返事ありがとうございます。

text使う場合は表示形式に気を付けてって事ですね。

分かりました。

BJさん
山内さん
お二人のお忙しい時間を割いてご協力ありがとうございました。

・ツリー全体表示


	【81810】Re:textについて

山内 - 21/6/1(火) 10:34 -


	引用なし

	パスワード

▼とうしたさん：
>＞BJ さん
>お返事ありがとうございます。
>BJさんのコードは私の中では見たことのないとてもスマートなコードでしたので、
>今度参考にさせてもらいます。
>
>因みに私のコードの先頭に●マークの部分だけは必須とした場合は、
>その中身は他にどんな書き方が有りますか？
>
>
>●Dim abc As Range
>●Set abc = Range("A1:A3")
>●If WorksheetFunction.CountBlank(abc) = 0 Then
>　　If abc.Text = "あ" Then
>　　　　Stop
>　　Else
>　　　　Stop
>　　End If
>●End If

複数選択のTextは表示形式にも左右されるようなのでそれに気をつけたら問題ないかも？
例
Range("A1").Value = "2021/6/1"
Range("B1").Value = "2021/6/2"

Range("A1:B1").NumberFormat = "yyyy/mm"
Debug.Print Range("A1:B1").Text

・ツリー全体表示


	【81809】Re:textについて

とうした - 21/6/1(火) 8:22 -


	引用なし

	パスワード

＞BJ さん
お返事ありがとうございます。
BJさんのコードは私の中では見たことのないとてもスマートなコードでしたので、
今度参考にさせてもらいます。

因みに私のコードの先頭に●マークの部分だけは必須とした場合は、
その中身は他にどんな書き方が有りますか？

●Dim abc As Range
●Set abc = Range("A1:A3")
●If WorksheetFunction.CountBlank(abc) = 0 Then
　　If abc.Text = "あ" Then
　　　　Stop
　　Else
　　　　Stop
　　End If
●End If

・ツリー全体表示


	【81808】Re:textについて

BJ - 21/6/1(火) 0:52 -


	引用なし

	パスワード

with range("A1:C10")
　if application.countif(.cells,.cells(1).value)=.cells.count then
　　 msgbox "全部同じ"
　else
　　 msgbox "なんか適当にやってる感じ"
　end if
end with

因みに全空白判定は入って無いので、提示されたコードを利用。

・ツリー全体表示


	【81807】textについて

とうした - 21/5/31(月) 21:19 -


	引用なし

	パスワード

セル範囲をrangeでセットして、
その範囲内の空白チェックを使うと前提した上での質問です。

その範囲内の値が全て特定の同じ値の場合と、
そうでない場合でif文を組もうとした時に、
vbaのローカルウィンドウ内のtextを確認すると、
全て同じならその値が、
一つでも異なればnullとなっていました。

これは使えると思ったのですが、この使い方で合っているのかどうかが知りたいです。

以下はそのコードになります。
Sub test()
　　Dim abc As Range
　　Set abc = Range("A1:A3")
　　If WorksheetFunction.CountBlank(abc) = 0 Then
　　　　If abc.Text = "あ" Then
　　　　　　Stop
　　　　Else
　　　　　　Stop
　　　　End If
　　End If
End Sub

・ツリー全体表示


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

33 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free