Excel VBA質問箱 IV

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

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


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

87 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【80732】Re:Dictionaryでの値集計

ピンク - 19/4/25(木) 8:28 -


	引用なし

	パスワード

▼永遠の超初心者さん：

If Cells(iR, iC).Value <> "" Then
　　buf = Cells(iR, iC).Value
　　If Not Dic.Exists(buf) Then
　　　　Dic.Add buf, buf
　　　　Dic.Item(buf) = Dic.Item(buf) + Cells(1, iC).Value
　　　　　　　　　↓
　　　　Dic.Item(buf) = Cells(1, iC).Value

------------------------------------------------
MsgBox "" + 100
この様な事をしてエラーになっていたの

・ツリー全体表示


	【80731】Re:Dictionaryでの値集計

永遠の超初心者 - 19/4/25(木) 8:00 -


	引用なし

	パスワード

ピンク様
ありがとうございます。
思い通りの結果が出せました。
その上、随分スマートにしていただきました。

ただ、前述のコードは色々なサイトを参考に書いたものなのですが
どこに不備があるのかわかりません。
今後の参考のためにご指摘いただけるとありがたいです。

・ツリー全体表示


	【80730】Re:シート複数選択印刷について

マナ - 19/4/24(水) 19:54 -


	引用なし

	パスワード

▼Hiroshi さん：

>　　strSN = ActiveSheet.Range("A1").Value
>　　strSN = ActiveSheet.Range("B1").Value
>　　strSN = ActiveSheet.Range("C1").Value

このままでは、３つの値を変数に同時いれることはできません。
配列にするとよいです。

　　Dim strSN(1 to 3) as String

　　strSN(1) = ActiveSheet.Range("A1").Value
　　strSN(2) = ActiveSheet.Range("B1").Value
　　strSN(3) = ActiveSheet.Range("C1").Value

　　Worksheets(strSN).Printout

・ツリー全体表示


	【80729】Re:Dictionaryでの値集計

ピンク - 19/4/24(水) 17:02 -


	引用なし

	パスワード

▼永遠の超初心者さん：

参考に
Sub Test1()
　　 Dim Dic As Object, c As Range
　　
　　Sheets("Sheet1").Activate
　　Range("F91:G110").ClearContents

　　Set Dic = CreateObject("Scripting.Dictionary")
　　For Each c In Range("J51:CE81")
　　　　If c.Value <> "" Then
　　　　　　Dic(c.Value) = Dic(c.Value) + Cells(1, c.Column).Value
　　　　End If
　　Next
　　Range("F91").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.keys)
　　Range("J91").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.Items)
　　Set Dic = Nothing
End Sub

・ツリー全体表示


	【80728】シート複数選択印刷について

Hiroshi - 19/4/24(水) 15:50 -


	引用なし

	パスワード

はじめまして

　VBAにてシートを複数選択し印刷するように組みたいのですが中々できないのでご教授をお願い致します。

A1　　B1　　C1　「A1、B1、C1」→印刷
A2　　B2　　C2　「A2、B2、C2」→印刷
A3　　B3　　C3　「A3、B3、C3」→印刷
・　　・　　・　　　　・
・　　・　　・　　　　・
・　　・　　・　　　　・
A100　B100　C100「A100、B100、C100」→印刷

　上記のセルにそれぞれのシート名が入っているのですが「A1、B1、C1」を作業グループとして印刷をするVBAを組もうとしております。シート名直接や配列、rangeでは複数選択できず上手く当てはまる物がないのでご教授をお願いします。

初めての質問になりますのでルール等反しておりましたらご指摘ください。

　いろんな方のサンプルを参考に組んでみたVBAですがこの場合だとC1セル名のシートしかアクティブになりませんでした。

Sub シート選択()

　　Dim strSN As String

　　' 変数 strSN にアクティブシートの A1 セルの値を代入
　　strSN = ActiveSheet.Range("A1").Value
　　strSN = ActiveSheet.Range("B1").Value
　　strSN = ActiveSheet.Range("C1").Value
　　
　　' 変数 strSN の名前をもつシートをアクティブにする
　　Worksheets(strSN).Select
　　
　　' 変数 strSN の名前をもつシートの B1 セルをアクティブにする
　　Worksheets(strSN).Range("A1").Select
　　Worksheets(strSN).Range("B1").Select
　　Worksheets(strSN).Range("C1").Select
　　
End Sub

・ツリー全体表示


	【80727】Dictionaryでの値集計

永遠の超初心者 - 19/4/24(水) 15:50 -


	引用なし

	パスワード

Dictionaryを使って、キーに対応するアイテムの合計を算出したいです。

キーとなる値=６桁の数値
アイテム=小数点を含む数値
キーの範囲=Range("J51:CE81")…一部空白セル有り
アイテムの範囲=Range("J1:CE1")…全て実装

下記のコードでは
(1)アイテムの合計はキーの数値にアイテムの数値が加算されたものになってしまいます。
　ex.キーが111111で,そのアイテムの合計が7.75の場合は１１１１１8.75
(2)試しにキーに文字列を代入すると★で"実行時エラー　13　型が一致しません"と出ます。

不備な点をご指摘ください。

Sub test()
Sheets("Sheet1").Activate
　Dim Dic As Object, buf, iR, iC, i, keys, iT
'管理ナンバー収集
Range("F91:G110").ClearContents
　Set Dic = CreateObject("Scripting.Dictionary")

　For iR = 51 To 81
　　For iC = 10 To 83
　　 If Cells(iR, iC).Value <> "" Then
　　　 buf = Cells(iR, iC).Value　　 'セルの値をbufに格納(キー)
　　　　 If Not Dic.Exists(buf) Then '未登録の場合
　　　　 Dic.Add buf, buf　　　　　　'セルの値を登録
　　　　　 Dic.Item(buf) = Dic.Item(buf) + Cells(1, iC).Value '対応する行1の値(アイテム)を加算していく★
　　　　 Else　　　　　　　　　　　　'登録済みの場合
　　　　　 Dic.Item(buf) = Dic.Item(buf) + Cells(1, iC).Value '対応する行1の値(アイテム)を加算していく
　　　　 End If
　　 End If
　　Next iC
　Next iR
　
　keys = Dic.keys
　For i = 0 To Dic.Count - 1
　 Cells(i + 91, 6) = keys(i) 'キーを表示
　Next i

　iT = Dic.Items
　For i = 0 To Dic.Count - 1
　 Cells(i + 91, 10) = iT(i) 'アイテムを表示
　Next i
　
　Set Dic = Nothing
End Sub

・ツリー全体表示


	【80726】Re:private sub のコードはどうやって探...

Taro

- 19/4/23(火) 21:58 -


	引用なし

	パスワード

マルチポストの件、了解いたしました。なかなか回答していただけないので、教えていただける方を探していました。
エクセルQ&Aサロンというところに初めて質問しました。
バカにされるような回答ばかりで、そこでの質問は迷宮入りを選択して終了しました。
あとはエクセル質問掲示板というところにも質問しています。

・ツリー全体表示


	【80725】Re:列挙型のメンバを文字列から特定する...

γ - 19/4/23(火) 21:34 -


	引用なし

	パスワード

できないと思います。
例えば、
Debug.Print　Eval("事業管理." & TextBox1.Text）
みたいな感じですか？それはできません。

むしろそう言うものは、Dictionaryか何かに持っておいて、
dic(TextBox1.Text)
とするんじゃないですか？

・ツリー全体表示


	【80724】Re:private sub のコードはどうやって探...

マナ - 19/4/23(火) 20:49 -


	引用なし

	パスワード

▼Taro さん：

マルチポストに関する基本方針です。
ご一読ください。

マルチポストについて
別のサイト（掲示板）にまったく同じ目的の投稿をすることを、一般に「マルチポスト」といいます。当質問箱では、マルチポストは原則認めています。つまり、ほかのサイトで質問したことをこのサイトで質問してもかまわないということです。

しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出しました」ということを宣言してください。そして、仮に他のサイトで解決したのなら、ここにも必ずその顛末を書いてください。質問しっぱなし、というのはモラルに反します。「解決したからいいや」というのではありません。

また、マルチポストを明示的に禁止しているサイトとのマルチポストをしてはいけません。

・ツリー全体表示


	【80723】列挙型のメンバを文字列から特定する方法

yasu - 19/4/23(火) 20:46 -


	引用なし

	パスワード

データーベースの項目（列）を列挙型で定義してあるものを，フォームなどで文字列を指定したときに列挙型のメンバ（定数）を取得する方法はあるでしょうか。 Enum 事業管理番号 = 1 名称契約者契約日金額　（以下続く）とあったときに，例えば文字列「名称」としたときに「2」を返したいと考えています。 C#やVB .Netでいうparseメソッドのような処理は，Excel VBAではできないのでしょうか。

・ツリー全体表示


	【80722】private sub のコードはどうやって探した...

Taro

- 19/4/23(火) 20:12 -


	引用なし

	パスワード

日記帳のようなものをエクセルで作りました。そのファイルを開いたら自動的に最終行が選択されるようにマクロ化しようと思いました。ウェブサイトでそのマクロを探してコピペしようと思いました。
日記帳のファイルを開き、マクロの記録で「最終行自動選択」と名前をつけてすぐに記録終了しました。
コピペしたマクロはプライベートサブだったので、マクロ一覧には表示されず、シート1ではなく、シート2に書き換えようとしたのですが、とこを探せばいいかわからないという状況です。
説明不足ですみませんでした。
ご協力いただけると嬉しいです。

・ツリー全体表示


	【80721】office365でPowerviewを使用したい

たけお - 19/4/23(火) 12:58 -


	引用なし

	パスワード

Excel2016でPowerViewを使用していました。
この度Windows10,Office365のパソコンに買い換えました。
PowerViewを開発タブの所に配置し、開発タブの｢Comアドイン｣を開くと｢Microsoft PowerView for Excel｣が表示されていなくて有効化ができません。
調べるとセキュリテイ上の理由によりFlash,Silverlight,衝撃波コントロールのライセンス認証がブロックされているとのこと。コントロールのブロックを解除するには無料のレジストキーのパッケージをダウンロードせよとありました。
それならと｢Enable Controls.Zip｣をエクスプローラの｢ダウンロード｣にダウンロードしました。
しかし、ダブルクリックしても、｢WinZipで開く｣をクリックしても何の反応も示さず、｢Comアドイン｣にも反映されていません。
｢Enable Controls ZIP｣がブロックを解除するレジストキーパッケージに相当しているのか、他に何か手順が間違ったのかと、途方にくれています。お助け下さい。

・ツリー全体表示


	【80720】Re:データを横にペーストしていきたい

リョウ - 19/4/22(月) 20:30 -


	引用なし

	パスワード

▼Y さん：サンプルをありがとうございます。ただ正直、理解しきれていないので時間を掛けて習得したいと思います・・。ご丁寧に教えていただきまして、ありがとうございました。

・ツリー全体表示


	【80719】Re:データを横にペーストしていきたい

γ - 19/4/21(日) 21:26 -


	引用なし

	パスワード

配列を使ったコード例。（色々な書き方があるので一例として）

Sub test2()
　　Dim lastRow As Long
　　Dim mysize　As Long
　　Dim mat()　 As Variant
　　Dim v　　　 As Variant
　　Dim k　　　 As Long
　　Dim j　　　 As Long
　　Dim m　　　 As Long
　　Dim kk　　　As Long
　　
　　Dim t　　　 '経過時間計測用
　　t = Timer
　　
　　lastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　
　　'できあがりの表の行数
　　mysize = WorksheetFunction.Ceiling(lastRow / 3, 1)
　　
　　'結果一時保持用配列の大きさを宣言
　　ReDim mat(1 To mysize, 1 To 9)
　　　　　　　　
　　'元データを配列vに取り込む
　　v = Range("A1").CurrentRegion.Resize(mysize * 3, 3).Value

　　For k = 1 To mysize * 3 Step 3
　　　　kk = Int((k - 1) / 3) + 1
　　　　For j = 1 To 3
　　　　　　For m = 1 To 3
　　　　　　　　mat(kk, (j - 1) * 3 + m) = v(k + j - 1, m)
　　　　　　Next
　　　　Next
　　Next

　　'纏めて書込む
　　[E1].Resize(mysize, 9).Value = mat
　　
　　Debug.Print "配列利用　"; Timer - t
End Sub

・ツリー全体表示


	【80718】Re:データを横にペーストしていきたい

リョウ - 19/4/21(日) 14:23 -


	引用なし

	パスワード

▼Y さん： >いったん二次元配列に結果を書き込んでおいて、 >それを一回の処理でまとめてシートに書き込む方法です。 >トライしてみてください。なるほど。あとは自分で色々と調べてみます。 >もっとも数千行くらいのデータであれば今の方法で十分でしょう。 >数万～数十万行のオーダーなら効果は大きいと思います。あっても数百行くらいのデータですので、特に考慮する必要は無さそうということで理解しました。早々にご返信いただきまして、本当にありがとうございました。また機会ありましたら、宜しくお願いいたします。

・ツリー全体表示


	【80717】Re:データを横にペーストしていきたい

γ - 19/4/21(日) 14:10 -


	引用なし

	パスワード

時間がかかるのは、シートへの書き込みです。
各セルにその都度書き込むとそれだけ時間が掛かりますから、
いったん二次元配列に結果を書き込んでおいて、
それを一回の処理でまとめてシートに書き込む方法です。
トライしてみてください。

もっとも数千行くらいのデータであれば今の方法で十分でしょう。
数万～数十万行のオーダーなら効果は大きいと思います。

・ツリー全体表示


	【80716】Re:データを横にペーストしていきたい

リョウ - 19/4/21(日) 11:13 -


	引用なし

	パスワード

▼リョウさん：ご教授ありがとうございます。希望通りの処理が行われることを確認しました。また「Mod」の使い方も理解しました。＞大量にある場合は、配列を利用することになると思います。度々で申し訳ございませんが、ここの文言がピンときていません。。実際はもっとデータが多いのですが、宜しければもう少し具体的に教えていただけると助かります。宜しくお願いいたします。

・ツリー全体表示


	【80715】Re:データを横にペーストしていきたい

γ - 19/4/21(日) 6:22 -


	引用なし

	パスワード

色々な書き方があると思いますが、下記は基本的だろうと思います。
大量にある場合は、配列を利用することになると思います。

Sub test()
　　Dim lastRow As Long
　　Dim k　　　 As Long
　　Dim rng　　 As Range
　　
　　lastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　
　　'最初の貼付先位置
　　Set rng = Cells(1, 5)
　　
　　For k = 1 To lastRow
　　　　'コピーペイスト
　　　　Cells(k, 1).Resize(1, 3).Copy rng
　　　　
　　　　'次の貼付先位置を設定
　　　　If k Mod 3 = 0 Then
　　　　　　Set rng = rng.Offset(1, -6)
　　　　Else
　　　　　　Set rng = rng.Offset(0, 3)
　　　　End If
　　Next
End Sub

・ツリー全体表示


	【80714】データを横にペーストしていきたい

リョウ

- 19/4/21(日) 1:29 -


	引用なし

	パスワード

VBAの初心者です。下記のコピー＆ペーストを、For～Nextのように繰り返して実行したいのですが、コードのイメージが涌かず質問させていただきます。【質問内容】・“A列～C列”にデータがあるとして、そのデータをE列から横に繋げてペーストしてきたいです。　1.“A1～C1”をコピーして、“E1（～G1）”にペースト。　2.“A2～C2”をコピーして、1.でペーストした１つの右の“H1（～J1）”にペースト。　3.“A列～C列”のデータを3回ペーストしたら、次のデータは1つ下のE列の行からペーストしていく。　4.これを“A列～C列”にデータが入力されているところまで繰り返す。　　（＝A列にデータが入力されているところまで）図が分かりづらいかもしれませんが、どなたかご教授いただけないでしょうか。もし過去に同様の質問があるようでしたら、お教えいただけると幸いです。宜しくお願いいたします。 -------------------------------------------------------------------- 　 A　 B　 C　　D　　E　　F　　G　　H　　I　　J　　K　　L　　M 1　A1　B1　C1　　　　A1　 B1　 C1 　A2 　B2 　C2 　A3　 B3 　C3 2　A2　B2　C2　　　　A4 　B4　 C4　　　　　　　　　　　　　　　　　　　　　 3　A3　B3　C3　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 4　A4　B4　C4 　　Range("A1:C1").Select 　　Selection.Copy 　　ActiveSheet.Paste Range("E1") 　　　　Range("A2:C2").Select 　　Selection.Copy 　　ActiveSheet.Paste Range("H1") 　　　　Range("A3:C3").Select 　　Selection.Copy 　　ActiveSheet.Paste Range("K1") 　　'3回ペーストしたら、下の行にペーストしていく　　Range("A4:C4").Select 　　Selection.Copy 　　ActiveSheet.Paste Range("E2") 　　　　Application.CutCopyMode = False

・ツリー全体表示


	【80713】Re:行番号列の列幅取得方法

［名前なし］ - 19/4/20(土) 12:33 -


	引用なし

	パスワード

▼マナさん：
>▼［名前なし］さん：
>
>>クラスモジュールでグラフのイベントを取得する方法は把握していましたが、
>>標準モジュールで完結する方法を求めていました。
>
>特定のグラフに限定してよいなら
>クラスモジュールでなくても、
>Thisworkbookやシートモジュールでよいです。
>
>クリックして取得するということはイベントだから
>標準モジュールだけで完結は不可能では？
>
>単に選択されている系列ということなら以下ではだめなのですか。
>ht　tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=80696;id=excel
ご提案頂きありがとうございます。

現在はグラフにマクロを登録して、イベントを取得しています。
URLの通りに実行してみましたが、SelectionがRangeのままの為、動作しませんでした。

GetCursorPosで取得した座標を以下の式で変形して近似値が取れたので、
正しい解決法ではありませんが、これで解決とさせて頂きます。

Po.y = Po.y - ActiveWindow.PointsToScreenPixelsY(CommandBars("Formula Bar").Height)
Po.x = (Po.x - ChartObj.ShapeRange.Left) * 72 / 96

ご教示頂きまして誠にありがとうございました。

・ツリー全体表示


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

87 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free