Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
232 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【77806】Re:VBA素人です。至急お願いいたします。
発言  β  - 15/12/30(水) 10:48 -
引用なし
パスワード
   ▼kenkyu-sya さん：

質問に回答をもらってからのほうがいいかとも思いますが、推測で。

Sub Test()
　　Dim r As Range
　　Dim a As Range
　　Dim f As Range
　　Dim t As Range
　　With Range("A1").CurrentRegion
　　　　With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
　　　　　　For Each r In .Rows
　　　　　　　　On Error Resume Next
　　　　　　　　Set a = r.SpecialCells(xlCellTypeConstants)
　　　　　　　　On Error GoTo 0
　　　　　　　　If Not a Is Nothing Then
　　　　　　　　　　Set f = a.Areas(1).Cells(1)
　　　　　　　　　　Set t = a.Areas(a.Areas.Count).Cells(a.Areas(a.Areas.Count).Cells.Count)
　　　　　　　　　　Range(f, t).Value = f.Value
　　　　　　　　End If
　　　　　　Next
　　　　End With
　　End With
End Sub
・ツリー全体表示
【77805】Re:VBA素人です。至急お願いいたします。
発言  β  - 15/12/30(水) 10:38 -
引用なし
パスワード
   ▼kenkyu-sya さん：

仮に　問１と問３と問５に回答していればどういった結果になりますか？

また、これは、こちらがとやかくいうことではありませんけど
本当に、問１と問５だけに回答。　問２〜問４は未回答だったということはないのでしょうかねぇ？
・ツリー全体表示
【77804】VBA素人です。至急お願いいたします。
質問  kenkyu-sya  - 15/12/30(水) 9:58 -
引用なし
パスワード
   至急のため、ヤフーの知恵袋にも同じような質問をしていることをご了承くださいませ。

VBA素人なのでご指導お願いします。

至急、しなければならない仕事が舞い込んでまいりました。

具体的には、アンケートデータなのですが、空白、つまり欠損している部分を補うという作業です。
ユーザーが問１から問５まで回答するというデータで、回答していれば表にユーザーIDを書きこんでいます。しかし、欠損値が多いため、その欠損している部分は、一定のルールをもって埋めることになりました。

エクセルで表を作成しており、添付してはいますが、実際は1000人規模のデータを扱わなければなりません。手作業ではミスを連発しそうなので条件式などを駆使してみましたがうまくいきません。知人にきくと、VBAでないと難しいのではないかと教えてくれました。

ルールなのですが、表でしめしておりますように、例えばUSER101は、問１と問５を回答していますが、欠損値の変換で問２，３，４も回答したこととみなす、としたいのです。

表にありますように、 「問い」と「問い」の間の「問い」が欠損しているものについて、USERが回答したとみなす、つまり、「問い」に挟まれた「問い」についてだけ欠損値を補うというというルールなのです。

なお、ルールから外れる、つまり問いと問いに挟まれていない欠損値はそのまま空白としたいと思います。

エクセルでデータを作成し、将来的には、統計ソフトで利用するつもりです。そこでVBAで作成したいのですが、VBAも最近そういう言葉を知ったくらいの知識の私には今、出来そうもありません。時間がありません。どうかよろしくお願いいたします。

　　　　変換前　　　　　　　　　　　　　　　　
USERID　　　　問１　　　　問２　　　　問３　　　　　問４　　　　問５　
101　　　　101　　　　　　　　　　　　　　　　101
102　　　　102　　　　102　　　　　　　　　　　　102
103　　　　103　　　　　　　　103　　　　　　　　
104　　　　104　　　　104　　　　　　　　104　　　　
105　　　　105　　　　　　　　105　　　　　　　　105
106　　　　　　　　106　　　　　　　　106　　　　106
107　　　　　　　　　　　　107　　　　　　　　107
108　　　　　　　　108　　　　　　　　108　　　　
109　　　　　　　　　　　　109　　　　　　　　109
110　　　　110　　　　110　　　　　　　　110


　　　　変換後　　　　　　　　　　　　　　　　
USERID　　　　問１　　　　問２　　　　問３　　　　　問４　　　　問５　
101　　　　101　　　　101　　　　101　　　　101　　　　101
102　　　　102　　　　102　　　　102　　　　102　　　　102
103　　　　103　　　　103　　　　103　　　　103　　　　103
104　　　　104　　　　104　　　　104　　　　104　　　　104
105　　　　105　　　　105　　　　105　　　　105　　　　105
106　　　　　　　　106　　　　106　　　　106　　　　106
107　　　　　　　　　　　　107　　　　107　　　　107
108　　　　　　　　108　　　　108　　　　108　　　　
109　　　　　　　　　　　　109　　　　109　　　　109
110　　　　110　　　　110　　　　110　　　　110
・ツリー全体表示
【77803】Re:一つのセル内にカンマで区切って表示
発言  γ  - 15/12/29(火) 8:09 -
引用なし
パスワード
   ああ、ポイントは、得点ランクをもとに自動判定する部分でしたか？
それと、文字列操作のもっと基本的な手法も書いておきましょう。

以下はサンプルです。
得点ランクが一つのケースです。必要なら繰り返しに持ち込んで下さい。

Sub test2()
　　Dim r As Range
　　Dim name As String
　　Dim score As Long
　　Dim s As String
　　Dim scoreRank As String
　　Dim lowScore As Long
　　Dim highScore As Long

　　Columns("E").ClearContents

　　scoreRank = Cells(1, 3).Value
　　lowScore = CLng(Split(scoreRank, "〜")(0))
　　highScore = CLng(Split(scoreRank, "〜")(1))
　　
　　For Each r In Range(Range("A1"), Range("A1").End(xlDown))
　　　　name = r.Value
　　　　score = r.Offset(, 1).Value
　　　　If score >= lowScore Then
　　　　　　If score <= highScore Then
　　　　　　　　s = s & name & ","
　　　　　　End If
　　　　End If
　　Next
　　s = Left(s, Len(s) - 1) '尻尾の","をカット
　　Cells(1, 4).Value = s
End Sub
・ツリー全体表示
【77802】Re:一つのセル内にカンマで区切って表示
発言  γ  - 15/12/28(月) 6:44 -
引用なし
パスワード
   一例です。

Sub test()
　　Dim dic As Object
　　Dim r As Range
　　Dim s As String
　　Dim name As String
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　'氏名、得点に基づき、該当する得点ランク別のdictionaryに氏名を保持
　　For Each r In Range([A1], [A1].End(xlDown))
　　　　name = r.Value
　　　　s = getRank(r.Offset(, 1).Value)
　　　　If Not dic.exists(s) Then
　　　　　　Set dic(s) = CreateObject("Scripting.Dictionary")
　　　　End If
　　　　dic(s)(name) = Empty
　　Next
　　
　　Columns("D").ClearContents
　　
　　'カンマで文字列連結して書き出し
　　For Each r In Range([C1], [C1].End(xlDown))
　　　　If dic.exists(r.Value) Then
　　　　　　r.Offset(, 1).Value = Join(dic(r.Value).keys, ",")
　　　　End If
　　Next
　
End Sub

'得点毎のランクを得る(得点は整数と仮定）
Function getRank(v As Long) As String
　　Select Case v
　　　　Case Is >= 90: getRank = "90〜100"
　　　　Case Is >= 70: getRank = "良"
　　　　Case Is >= 50: getRank = "可"
　　　　Case Else: getRank = "不可"
　　End Select
End Function
・ツリー全体表示
【77801】一つのセル内にカンマで区切って表示
質問  A/C  - 15/12/27(日) 23:50 -
引用なし
パスワード
   Ａ列縦に苗字が入っていて、その人数はその都度かわります。Ｂ列にある試験の点数が表示されています。Ｃ１に９０〜１００とあり、これは成績が９０点から１００点までという意味で、Ｄ１にその点数の範囲内にある苗字がカンマで区切られて全て表示させるようにしたいのですが、そのプログラムが全くわかりません。
どなたか教えてください。よろしくお願いします。
・ツリー全体表示
【77800】Re:IE操作におけるテーブル行の選択につ...
お礼  失礼します  - 15/12/24(木) 11:00 -
引用なし
パスワード
   ▼γ様

ご質問を頂きありがとうございます。

回答が遅れ、質問内容に情報が不足しており、
大変申し訳ありませんでした。

選択後に期待する動作といたしまして、「OK」ボタンをクリックすることにより、選択したデータを保持したまま次の画面へと遷移する、ということを考えておりました。
そのため、行を選択状態にしないと期待した動作が得られないという状況でありました。

その後、無事、解決致しましたので以下に備忘として記載させて頂きます。

============================

マウスでクリックをした際にはHTMLが書き換わるように実装されていたようで、
HTMLにおけるTRタグのClassNameに「Selected」の文字列が設定されるようになっていました。

そのため、VBA上でもClickイベントを発生させるのではなく、
直接ClassNameプロパティに「Selected」を設定することで
期待した動作を得られるようになりました。

============================

手を尽くし切れていない状態で質問を投稿してしまい申し訳ありませんでした。

また、拙い質問にお付き合い頂きありがとうございました。
・ツリー全体表示
【77799】Re:イミディエイトを使用禁止にする方法
お礼  pieta  - 15/12/23(水) 23:27 -
引用なし
パスワード
   γ さん

回答ありがとうございました。
・ツリー全体表示
【77798】Re:イミディエイトを使用禁止にする方法
発言  γ  - 15/12/23(水) 22:56 -
引用なし
パスワード
   それ言いだしたら、新しいプロシージャで
　Application.EnableEvents = False
を実行することもできるし、
更に言えば、マクロ自体を無効にすることもできます。
そもそもから検討されたほうがよいかもしれません。
・ツリー全体表示
【77797】イミディエイトを使用禁止にする方法
質問  pieta  - 15/12/23(水) 22:47 -
引用なし
パスワード
   BeforePrintイベントでプリントアウトを禁止する設定にしたのですが
イミディエイトウィンドウでApplication.EnableEvents = Falseを実行すると
印刷出来てしまいます。

vbaでイミディエイトを使えないように出来ないものでしょうか？
・ツリー全体表示
【77796】Re:セルの結合→貼付け
お礼  ぼぶ  - 15/12/23(水) 12:40 -
引用なし
パスワード
   γ様

ご回答ありがとうございます。

教えていただいた方法で希望していた通りに動作致しました。

VBAはまだまだ初心者で、1動作ずつ勉強しながら手さぐりで作成しているので、
また変数iの使い方や結合の問題などについてもアドバイス頂き、とても勉強になります！

セル結合については、Sheet2は印刷用のシートとして使う為、
レイアウト的な関係で結合することにしているのですが、
不具合が発生するようでしたら、γ様に教えていただいたコードを参考に、
自分なりに結合しないやり方を考えてみようと思います。

本当にありがとうございました！
・ツリー全体表示
【77795】Re:セルの結合→貼付け
発言  γ  - 15/12/23(水) 6:19 -
引用なし
パスワード
   コードの一例です。

Sub harituke()
　　Dim ws1 As Worksheet
　　Dim ws2 As Worksheet
　　Dim rng As Range
　　Dim lastrow As Long
　　Dim k As Long
　　Dim r As Long
　　Dim c As Long
　　Dim code As String
　　Dim item As String

　　Set ws1 = Worksheets("Sheet1")
　　Set ws2 = Worksheets("Sheet2")

　　r = 1 - 8　 '転記先行番号初期値

　　lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
　　For Each rng In ws1.Range("A2:A" & lastrow)
　　　　code = rng.Offset(0, 1).Value
　　　　item = rng.Offset(0, 2).Value
　　　　If rng.Value = "■" Then
　　　　　　If k Mod 2 = 0 Then
　　　　　　　　r = r + 8
　　　　　　　　c = 1
　　　　　　Else
　　　　　　　　c = 5
　　　　　　End If

　　　　　　ws2.Cells(r, c).Value = code & item
　　　　　　ws2.Cells(r, c).Resize(8, 4).Merge

　　　　　　k = k + 1
　　　　End If
　　Next
End Sub

コメント:
(1)変数i は伝統的に、整数、とりわけループ変数に用いられるので、
　 その慣習に従ったほうが違和感は少ないです。
　 論理的には間違いとは言えないが、普通、こういうiの使い方はしません。
(2)セル結合が本当に必要か、よく検討したほうが良いです。
　 セル結合するとあとあとの処理で色々な困難が待ち構えています。
　 できれば避けるべきですね。
　
・ツリー全体表示
【77794】セルの結合→貼付け
質問  ぼぶ  - 15/12/23(水) 3:59 -
引用なし
パスワード
   初めて質問させていただきます。

Shee1に下記のような商品の管理表があります。
（実際のデータ行は100件以上あります）

　A　　　　　B　　　　　　　　　C
1選択　　　　商品コード　　　　商品名
2■　　　　AA1111　　　　　　　　リンゴ
3■　　　　AA2222　　　　　　　　バナナ
4□　　　　AA3333　　　　　　　　みかん
5■　　　　AA4444　　　　　　　　桃
6□　　　　AA5555　　　　　　　　メロン
7■　　　　AA6666　　　　　　　　イチゴ

A列が■になっている行の商品コードと商品名を合体（例：AA1111リンゴ）させて、
それをSheet2に貼り付けていくマクロを作りたいと思っています。

Sheet2はセルをA1:D8（1.）、E1:H8（2.）、A9：D16（3.）、E9：H16（4.）という風にそれぞれ結合したうえで、
1.2.3.4.の順番（Zを描くような動き）で貼り付けていきたいです。
（上記の例ですと、1.にAA1111リンゴ、2.にAA2222バナナ、3.にAA4444桃、4.にAA6666イチゴとなります）

また、初期状態ではA1:D8などのセルの結合はされていない真っ白な状態なので、
セルの結合⇒貼付け、セルの結合⇒貼付け…という動作が必要になります。

■になっている行の商品コードと商品名を合体させて取得するところまでは、
いろいろ参考にしながら下記のように書いたのですが、
それをSheet2に、セルを結合しながら、Zを描くような動きで貼り付ける動作が全く分からずとても困っています。
是非お力をお貸しください。よろしくお願いいたします。

-------------------------------------------------------
Sub harituke()
　　Dim i As Range
　　Dim lastrow As Long
　　
　　lastrow = Cells(Rows.Count, 1).End(xlUp).Row
　　For Each i In Range("A2:A" & lastrow)
　　　　code = i.Offset(0, 1).Value
　　　　item = i.Offset(0, 2).Value
　　　　　If i = "■" Then
　　　　　　ここにセル結合＆貼付けの動作？？？
　　End If
　　Next i
　　
End Sub
・ツリー全体表示
【77793】Re:早速の返信、ありがとうございます。
お礼  勉強中  - 15/12/23(水) 0:44 -
引用なし
パスワード
   >▼β さん：
希望通りの操作が出来ました。重ねて御礼申し上げます。
ありがとうございました。
・ツリー全体表示
【77792】Re:早速の返信、ありがとうございます。
お礼  勉強中  - 15/12/23(水) 0:00 -
引用なし
パスワード
   ▼β さん：
返信が遅くなり申し訳ございませんでした。モードレス表示です。
さっそく、トライしてみます。結果もご報告させていただきます。
ＶＢＡは奥が深く難しいですが、これからもコツコツ勉強します。
初心者の私にも分かりやすく教えていただき、感謝申し上げます。
・ツリー全体表示
【77791】Re:早速の返信、ありがとうございます。
発言  β  - 15/12/22(火) 22:44 -
引用なし
パスワード
   ▼勉強中 さん：

ところでユーザーフォームはモードレス表示ですか？モーダル表示ですか？
・ツリー全体表示
【77790】Re:IE操作におけるテーブル行の選択につ...
発言  γ  - 15/12/22(火) 21:21 -
引用なし
パスワード
   回答ではないのですが。

仮に選択できたとして、その後何をしようとされていますか？
その行をどこかにコピーペイストしたいとか、ですか？
選択しなくても、なんらかの方法でそれが特定できるならOKとはなりませんか？
・ツリー全体表示
【77789】Re:早速の返信、ありがとうございます。
発言  β  - 15/12/22(火) 17:38 -
引用なし
パスワード
   ▼勉強中 さん：

WindowState ではなく Application.Visible を使った例です。
UserForm1のCommandButton1をクリックするたびに、エクセルの表示・非表示を
切り替えます。

新規ブックで試してみてください。
UserForm1にはCommandButton1 を配置してください。

ThisWorkbookモジュール

Private Sub Workbook_Open()
　　Application.OnTime Now(), "ThisWorkbook.ShowForm"
　　Application.Visible = False
End Sub

Sub ShowForm()
　　UserForm1.Show
End Sub

ユーザーフォームモジュール

Private Sub CommandButton1_Click()
　　Application.Visible = Not Application.Visible
End Sub
・ツリー全体表示
【77788】早速の返信、ありがとうございます。
発言  勉強中  - 15/12/22(火) 16:55 -
引用なし
パスワード
   ご指摘の通り、Workbook_Open()で最小化を指示しています。作業内容は、Excelを最小化してVBAで作成したフォームのみ表示。しかし、そのフォームの中にあるシート(Excelの表)を呼び出す時、タスクバーをクリック(Excelアイコン)しないと表示されません。そこで、特定のシートを開く際に、自動で最大化にさせたいと思います。基本用語も使えず、適切な説明が出来ず申し訳ございません。まだまだ、勉強不足でお恥ずかしいかぎりですが、ご指導のほどよろしくお願いいたします。
・ツリー全体表示
【77787】Re:最小化→最大化
発言  β  - 15/12/22(火) 15:50 -
引用なし
パスワード
   ▼勉強中 さん：

>意味がいまいちわかりません。

>ファイルを開く際、Excelを最小化（Application.WindowState = xlMinimized）
>させています

Workbook_Open あたりで行っているのでしょうか？
いずれにしても、エクセルは【最小化】になっているんですよね？
で、「シート毎の」解除（xlMaximized等？）ですけど、どんな操作を考えているのですか？
何かしようとするとタスクバーをクリックせざるを得ないですよね？
そうすると、エクセルは、最小化させる前の状況、おそらく最大化になるんでしょうね？
その時のシートは、たまたまブックを開いたときに最前面に出ていたシートです。

で、「シート毎に解除」？？
どんな操作をしたときにどうしたいのですか？
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
232 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free