Excel VBA質問箱 IV

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

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


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

105 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【80368】Re:ListView：行がどんどん増えてしまう

愛沢 - 19/2/1(金) 23:59 -


	引用なし

	パスワード

マナ様
ありがとうございます、愛沢です。

急な出張でマクロが弄れずお礼が遅くなった事をお詫びいたします。

>Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
>　　No = Item
>　　名前 = Item.SubItems(1)
>　　Call 団員登録表示処理
>　　団員登録.Show
>　　Item = No
>　　Item.SubItems(1) = 名前
>End Sub

に変えた所、引数は省略できません。で怒られました

Private Sub CommandButton3_Click()
　　Call 団員登録更新処理
End Sub

コールで作成するのはもっと勉強してからにして今回はコールを使わずに作成してみようかと思います。

貴重なお時間ありがとうございました。

・ツリー全体表示


	【80367】Re:vba詳しい方、お力貸してください

マナ - 19/2/1(金) 22:14 -


	引用なし

	パスワード

▼ミリヤさん：

>一人分だけならうまくいきました！！！

コードを理解できていますか？
ちょっと違いますが、このあたりを参考になります。
ht　tps://www.moug.net/tech/exvba/0060003.html

・ツリー全体表示


	【80366】Re:カレンダーに予定を自動入力したい

マナ - 19/2/1(金) 22:00 -


	引用なし

	パスワード

▼VBA初心者さん：

>追加でご質問させていただいてもよろしいでしょうか？

そのまえに、わたしの提示したマクロでは検索できていませんよね。
それでもよいのですか？

・ツリー全体表示


	【80365】Re:vba詳しい方、お力貸してください

ミリヤ - 19/2/1(金) 16:36 -


	引用なし

	パスワード

▼マナさん：
一人分だけならうまくいきました！！！
これを複数ファイルにおこないたいのですが。。
何かいい方法はないでしょうか。

・ツリー全体表示


	【80364】Re:カレンダーに予定を自動入力したい

γ - 19/2/1(金) 11:59 -


	引用なし

	パスワード

カレンダには日付データが、日を表示するだけの形式でセットされているとの前提です。
straightforwardに、こんなコードではどうでしょうか。

Sub カレンダー入力2()
　　Dim ws　　　　　As Worksheet
　　Dim lastRow　　 As Long　　
　　Dim rngCalendar As Range　　
　　Dim rngFound　　As Range　
　　Dim d　　　　　 As Long
　　Dim s　　　　　 As String
　　Dim k　　　　　 As Long

　　Set ws = Worksheets("Sheet1")
　　lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
　　Set rngCalendar = ws.Range("E1:K10")

　　For k = 1 To lastRow
　　　　d = ws.Cells(k, "A").Value　'日付け
　　　　s = ws.Cells(k, "B").Value　'スケジュール
　　　　Set rngFound = rngCalendar.find(Day(d), After:=rngCalendar(1), _
　　　　　　LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
　　　　　　MatchCase:=False, MatchByte:=False, SearchFormat:=False)
　　　　
　　　　'日でマッチさせると、たかだか2回マッチするだけなのでDo Loopは不要?
　　　　If d = rngFound.Value Then
　　　　　　Call setSchedule(rngFound.Offset(1, 0), s)
　　　　Else
　　　　　　Set rngFound = rngCalendar.FindNext(rngFound)
　　　　　　If Not rngFound Is Nothing Then
　　　　　　　　If d = rngFound.Value Then
　　　　　　　　　　Call setSchedule(rngFound.Offset(1, 0), s)
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　Next
End Sub
Function setSchedule(r As Range, s As String)
　　If r.Value = "" Then
　　　　r.Value = s
　　Else
　　　　r.Value = r.Value & vbLf & s
　　End If
End Function

・ツリー全体表示


	【80363】Re:カレンダーに予定を自動入力したい

VBA初心者 - 19/2/1(金) 11:48 -


	引用なし

	パスワード

▼マナさん：
>▼VBA初心者さん：
>
>こんな感じのことでしょうか
>
>Option Explicit
>
>Sub カレンダー入力()
>　　Dim rngカレンダー As Range
>　　Dim rng予定表 As Range
>　　Dim c As Range
>　　Dim rng検索 As Range
>　　Dim 業務 As String
>　　
>　　Set rngカレンダー = Worksheets("Sheet2").Range("E1:K10")
>　　Set rng予定表 = Worksheets("Sheet1").Range("A1").CurrentRegion
>　　
>　　For Each c In rng予定表.Columns(1).Cells
>
>　　　　Set rng検索 = rngカレンダー.Find(c.Value, LookAt:=xlWhole)
>　　　　
>　　　　If Not rng検索 Is Nothing Then
>　　　　　　With rng検索.Offset(1, 0)
>　　　　　　　　業務 = WorksheetFunction.Trim(c.Offset(0, 1).Value & " " & .Value)
>　　　　　　　　.Value = Join(Split(業務), vbLf)
>　　　　　　End With
>　　　　End If
>　　　　
>　　Next c
>　　
>End Sub
>
>
>　
マナ様

先のご返答に引き続きありがとうございます。
とても参考になります。

追加でご質問させていただいてもよろしいでしょうか？

Set rngカレンダー = Worksheets("Sheet2").Range("E1:K10")
Set rng予定表 = Worksheets("Sheet1").Range("A1").CurrentRegion

↑の部分で

rngカレンダーをworksheet2(1月)～worksheet13(12月)までの.range("A1:H14)までにしたい場合は
Set rngカレンダー = Worksheets(Array("1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月").range("A1:H14")

で合っていますか？

・ツリー全体表示


	【80362】Re:カレンダーに予定を自動入力したい

VBA初心者 - 19/2/1(金) 10:05 -


	引用なし

	パスワード

▼マナさん：
>▼VBA初心者さん：
>
>１）カレンダーなのに、日付検索で複数ヒットする可能性がありますか。
>Do～Loopは必要ないのでは？
>ということです。
>
>２）シリアル値に変換する必要ありますか。
>というか、検索できますか？
>
>３）文法が間違っている
>>Range(myObj).Offset(1, 0).Activate
>>Q = Range(myObj).Offset(1, 0).Activate
>>Set Q = Worksheets("Sheet1").Cells(Z, 2).Value
>
>４）変数名がわかりにくいです（人のこと言えませんが…）
>
>　

マナ様

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

上記内容に関して返答させていただきます。

1)カレンダーなのに、日付検索で複数ヒットする可能性がありますか。
Do～Loopは必要ないのでは？ということです。

→エクセルのカレンダーのテンプレート(1月～12月でsheetが分けられて表示されるもの)を使っています。sheetは行に5週分の日数、列に日曜～土曜の曜日が入力されています。その中で、2019年1月のsheetは31日が木曜日なので、残りの金曜日と土曜日の枠には2月1,2日が入力されています。その中で全部のsheetを参照すると重複する箇所が出てくるのでDo～Loopを使用してみました。

2)シリアル値に変換する必要ありますか。というか、検索できますか？

→自分が入力した日付をそのままカレンダーで検索することが出来なかった（私が無知だということが原因です・・・。）のでシリアル値なら検索できるかなと考え、一度日付を変更して検索するという手段をとりました。
検索は出来ていると思います。

3)文法の指摘、ありがとうございます。

4)大変申し訳ありません。自分だけが今何をやっているのか理解できるようにつけていたので、混乱させてしまいました。

・ツリー全体表示


	【80361】Re:カレンダーに予定を自動入力したい

VBA初心者 - 19/2/1(金) 9:33 -


	引用なし

	パスワード

▼γ さん：
>コードだけではなく、
>・現在のシートのレイアウト（行番号、列番号がわかるもの）と
>・どういうことを実行したいのかを
>説明するのが先でしょう。
>
>あなたの頭にあることを、
>間違っているコードで想像するのは大変です。

γ様

お返事ありがとうございます。
無知で大変申し訳ありません。

現在のシートレイアウトは、

・A列に自分が入力した日付
・B列に自分が入力した文字列
・E1～K10までにエクセルのテンプレートにあるカレンダー(1月分)を引用したもの（日付の下に空白セルがありメモが取れるようになっています）

私がやりたいことは、

B列に入力した文字列をA列に入力した日付と同じ日付のカレンダーのメモ欄に自動で入力してほしいということです。

また現在は1月分だけですが、最終的にはシートを分けて1月～12月までのカレンダーに自動入力できるようにしたいです。

宜しくお願い致します。

・ツリー全体表示


	【80360】Re:カレンダーに予定を自動入力したい

マナ - 19/1/31(木) 22:47 -


	引用なし

	パスワード

▼VBA初心者さん：

こんな感じのことでしょうか

Option Explicit

Sub カレンダー入力()
　　Dim rngカレンダー As Range
　　Dim rng予定表 As Range
　　Dim c As Range
　　Dim rng検索 As Range
　　Dim 業務 As String
　　
　　Set rngカレンダー = Worksheets("Sheet2").Range("E1:K10")
　　Set rng予定表 = Worksheets("Sheet1").Range("A1").CurrentRegion
　　
　　For Each c In rng予定表.Columns(1).Cells

　　　　Set rng検索 = rngカレンダー.Find(c.Value, LookAt:=xlWhole)
　　　　
　　　　If Not rng検索 Is Nothing Then
　　　　　　With rng検索.Offset(1, 0)
　　　　　　　　業務 = WorksheetFunction.Trim(c.Offset(0, 1).Value & " " & .Value)
　　　　　　　　.Value = Join(Split(業務), vbLf)
　　　　　　End With
　　　　End If
　　　　
　　Next c
　　
End Sub

　

・ツリー全体表示


	【80359】Re:EXCELのユーザーフォームにあるリスト...

くるみ - 19/1/31(木) 21:53 -


	引用なし

	パスワード

私の認識不足ですね。
基本そのような対応が必要になっているとは思いませんでした。

不快な思いをさせてすみません。

誤解がないよう申し上げておきますが、解決次第他サイトでも報告するつもりでした。
そのことはご理解いただければと存じます。

・ツリー全体表示


	【80358】Re:EXCELのユーザーフォームにあるリスト...

マナ - 19/1/31(木) 21:09 -


	引用なし

	パスワード

▼くるみさん：

エクセルの学校もマルチポストに関しては同じような方針ですが
個人的には、どちらかに絞ったほうがよいと思います。

本サイトの基本方針
ht　tp://www.vbalab.net/bbspolicy.html

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

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

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

・ツリー全体表示


	【80357】Re:カレンダーに予定を自動入力したい

マナ - 19/1/31(木) 20:59 -


	引用なし

	パスワード

▼VBA初心者さん：

１）カレンダーなのに、日付検索で複数ヒットする可能性がありますか。
Do～Loopは必要ないのでは？
ということです。

２）シリアル値に変換する必要ありますか。
というか、検索できますか？

３）文法が間違っている
>Range(myObj).Offset(1, 0).Activate
>Q = Range(myObj).Offset(1, 0).Activate
>Set Q = Worksheets("Sheet1").Cells(Z, 2).Value

４）変数名がわかりにくいです（人のこと言えませんが…）

　

・ツリー全体表示


	【80356】Re:カレンダーに予定を自動入力したい

γ - 19/1/31(木) 20:34 -


	引用なし

	パスワード

コードだけではなく、
・現在のシートのレイアウト（行番号、列番号がわかるもの）と
・どういうことを実行したいのかを
説明するのが先でしょう。

あなたの頭にあることを、
間違っているコードで想像するのは大変です。

・ツリー全体表示


	【80355】EXCELのユーザーフォームにあるリストボ...

くるみ - 19/1/31(木) 18:29 -


	引用なし

	パスワード

◆◆質問内容

EXCELでユーザーフォームを作り、データベースから条件に当てはまるものをリストボックスで一覧表示させています。
表示させているものは、Worksheetsは顧客情報にある列「顧客名」、「顧客分類」、「状態」の情報です。

Changeを使用しそれぞれに該当するテキストボックスorコンポボックスに入力があると、リストボックスに表示される仕組みなのですが、「顧客分類」にある”販売済"だけを省いて表示するような仕組みができないかと、チェックボックスを作ってやってみたのですができません。

どなたかご教授よろしくお願いいたします。

◆◆全体コード

Option Explicit

Private Sub TextBox1_Change()
　　Call SetListBox
End Sub

Private Sub UserForm_Initialize()
　　rtnNo = 0
　　Call SetBunruiList
　　Call SetListBox

End Sub

'ここを追加

Private Sub CheckBox1_Click()

　　Dim i As Long
　　
　　If Me.CheckBox1.Value = True Then
　　　　With Me.lst顧客リスト
　　　　　　For i = .ListCount To 1 Step -1
　　　　　　　　If .Cells(.Range("顧客分類列")) = "販売済" Then
　　　　　　　　　　.RemoveItem (i - 1)
　　　　　　　　End If
　　　　　　Next
　　　　End With
　　End If
　　
End Sub

'ここまで追加

Private Sub SetBunruiList()
　　Dim wRow　　　　As Long
　　
　　Me.cmb顧客分類.Clear
　　For wRow = 3 To Worksheets("顧客分類").Range("A1").CurrentRegion.Rows.Count
　　　　Me.cmb顧客分類.AddItem Worksheets("顧客分類").Cells(wRow, 1)
　　Next
End Sub

Private Sub txt顧客名_Change()
　　Call SetListBox
End Sub

Private Sub cmb顧客分類_Change()
　　Call SetListBox
End Sub

Private Sub lst顧客リスト_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
　　rtnNo = Me.lst顧客リスト.Text
　　Unload Me
End Sub

Private Sub SetListBox()
　　Dim wRow　　　　As Long
　　Dim wLstRow　　 As Long
　　Dim wHitFlg　　 As Boolean
　　
　　Me.lst顧客リスト.Clear
　　wLstRow = 0
　　With Worksheets("顧客情報")
　　　　For wRow = 2 To .Range("A1").CurrentRegion.Rows.Count
　　　　　　wHitFlg = True
　　　　　　If Me.txt顧客名 <> "" Then
　　　　　　　　If InStr(1, .Cells(wRow, .Range("顧客名列").Column), Me.txt顧客名, vbTextCompare) = 0 Then
　　　　　　　　　　wHitFlg = False
　　　　　　　　End If
　　　　　　End If
　　　　　　If Me.cmb顧客分類 <> "" Then
　　　　　　　　If .Cells(wRow, .Range("顧客分類列").Column) <> Me.cmb顧客分類 Then
　　　　　　　　　　wHitFlg = False
　　　　　　　　End If
　　　　　　End If
　　　　　　 If Me.TextBox1 <> "" Then
　　　　　　　　If InStr(1, .Cells(wRow, .Range("状態列").Column), Me.TextBox1, vbTextCompare) = 0 Then
　　　　　　　　　　wHitFlg = False
　　　　　　　　End If
　　　　　　End If
　　　　　　If wHitFlg = True Then
　　　　　　　　Me.lst顧客リスト.AddItem ""
　　　　　　　　Me.lst顧客リスト.List(wLstRow, 0) = wRow
　　　　　　　　Me.lst顧客リスト.List(wLstRow, 1) = Worksheets("顧客情報").Cells(wRow, 2)
　　　　　　　　Me.lst顧客リスト.List(wLstRow, 2) = Worksheets("顧客情報").Cells(wRow, 3)
　　　　　　　　Me.lst顧客リスト.List(wLstRow, 3) = Worksheets("顧客情報").Cells(wRow, 8)

　　　　　　　　wLstRow = wLstRow + 1
　　　　　　End If
　　　　Next
　　End With
　　
　　'ここを追加

　　Dim i As Long
　　
　　 If Me.CheckBox1.Value = True Then
　　　　With Me.cmb顧客分類
　　　　　　For i = .ListCount To 1 Step -1
　　　　　　　　If .List(i - 1, 2) = "販売済" Then
　　　　　　　　　　.RemoveItem (i - 1)
　　　　　　　　End If
　　　　　　Next
　　　　End With
　　 End If

　　'ここまでついか
　　
　　件数 = lst顧客リスト.ListCount

End Sub

◆◆やったこと

'Private Sub CheckBox1_Click()
に以下構文を追加
　　Dim i As Long
　　
　　If Me.CheckBox1.Value = True Then
　　　　With Me.lst顧客リスト
　　　　　　For i = .ListCount To 1 Step -1
　　　　　　　　If .Cells(.Range("顧客分類列")) = "販売済" Then
　　　　　　　　　　.RemoveItem (i - 1)
　　　　　　　　End If
　　　　　　Next
　　　　End With
　　End If
　　
End Sub

'Private Sub SetListBox()に以下構文を追加

Dim i As Long
　　
　　 If Me.CheckBox1.Value = True Then
　　　　With Me.cmb顧客分類
　　　　　　For i = .ListCount To 1 Step -1
　　　　　　　　If .List(i - 1, 2) = "販売済" Then
　　　　　　　　　　.RemoveItem (i - 1)
　　　　　　　　End If
　　　　　　Next
　　　　End With
　　 End If

・ツリー全体表示


	【80354】カレンダーに予定を自動入力したい

VBA初心者 - 19/1/31(木) 12:44 -


	引用なし

	パスワード

初めまして。メーカー系の会社に勤めていて、最近VBAを勉強し始めた者です。
エクセルの表を使って業務予定を管理しているのですが、カレンダーでも予定を管理したいと思っています。
その際にエクセルに入力した予定をそのままカレンダーに反映させることは出来ないかと考え、下のようなVBAを作ってみたのですが上手く動きません。
なぜ動かないのか教えていただきたいです。
また、「もっとこうした方がいいよ」などのアドバイス等ありましたら
宜しくお願い致します。

Sub カレンダー入力()

Dim A As Date 　‘日付
Dim B As Long　 ‘シリアル値
Dim Z As Long　 ‘行数

Dim i As Integer　‘sheet1の最終行変数

Dim myRange As Range　‘カレンダー選択範囲
Dim myObj As Range　　‘シリアル値が一致しているセル
Dim keyWord As String　‘一致しているシリアル値
Dim firstcell As Range　‘一致しているシリアル値の最初のセル
Dim Q As Range　‘一致しているシリアル値の真下のセル

For Z = 1 To i

i = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row　'sheet1の最終行数を格納

A = Worksheets("Sheet1").Cells(Z, 1).Value　‘日付を読み取る

B = CLng(A) ‘日付をシリアル値に変更
　
Set myRange = Range("E1:K10")　‘検索したいカレンダーの範囲を選択

keyWord = B　
　　
Set myObj = myRange.Find(keyWord, LookAt:=xlWhole)　‘シリアル値が一致しているセルを探す
　　
　　If Not myObj Is Nothing Then　‘一致したシリアル値が1つだけでなかった場合
　　　
　　　Set firstcell = myObj　'最初のセルを選択
　　
　　　Do
　　
　　　Set myObj = Cells.FindNext(myObj)　'次に一致したセルを選択

　　　Range(myObj).Offset(1, 0).Activate　'その真下のセルを選択
　　　
　　　Q = Range(myObj).Offset(1, 0).Activate　
　　　
　　　　　　
　　　　　　If Q = "" Then　‘真下のセルが空白だった時
　　　　　
　　　　　　Set Q = Worksheets("Sheet1").Cells(Z, 2).Value　‘sheet1の値を入れる
　　　　　　

　　　　　　Else
　　　　　　　
　　　　　　　If VarType(ActiveCell.Offset(1, 0)) = 3 Then　‘既に文字が入っていた場合
　　　　　　　　 Set Q = Worksheets("Sheet1").Cells(Z, 2).Value & vbLf & Str(Q)　
　　　　　　　
　　　　　　　Else
　　　　　　　　 Set Q = Worksheets("Sheet1").Cells(Z, 2).Value & vbLf & Str(Q)
　　　　　　　　
　　　　　　　End If
　　　　　　
　　　　　 End If
　　　
　　　　Loop While myObj.Address <> firstcell.Address

　　 End If
　　　　
Next Z　　
　　　
End Sub

・ツリー全体表示


	【80353】Re:ListView：行がどんどん増えてしまう

マナ - 19/1/30(水) 20:43 -


	引用なし

	パスワード

▼愛沢さん：

>Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
>　　No = Item
>　　名前 = Item.SubItems(1)
>　　Call 団員登録表示処理
>　　団員登録.Show
>End Sub

呼び出しが多すぎてわかりにくいですが
こうではありませんか？

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
　　No = Item
　　名前 = Item.SubItems(1)
　　Call 団員登録表示処理
　　団員登録.Show
　　Item = No
　　Item.SubItems(1) = 名前
End Sub

・ツリー全体表示


	【80352】Re:条件分岐について

WKB - 19/1/30(水) 11:52 -


	引用なし

	パスワード

ありがとうございます。
記述の仕方を色々勉強したかったので大変参考になりました。

・ツリー全体表示


	【80351】Re:条件分岐について

hatena - 19/1/30(水) 11:14 -


	引用なし

	パスワード

With Cells(i, "C") 　　If .Value <> "A" And .Value <> "B" And .Value <> "C" _ 　　　 And Cells(i, "D") <> 100 Then 　　　　処理１　　End If End With とか、 If Cells(i, "C") Like "[!ABCD]" And Cells(i, "D") <> 100 Then 　　処理１ End If

・ツリー全体表示


	【80350】条件分岐について

WKB - 19/1/30(水) 10:46 -


	引用なし

	パスワード

======================
cells(i,"C")が　A・B・C・Dではない
かつ
Cell(i,"D")が　100ではない
処理１
======================
If cells(i,"C") <> "A" Then
　If cells(i,"C") <> "B" Then
　　If cells(i,"C") <> "C" Then
　　　If cells(i,"C") <> "D" Then
　　　　If cells(i,"D") <> 100 Then
　　　　　処理１
　　　　End If
　　　End If
　　End If
　End If
End If
上記コードで動くには動くんですが、
もっとスマートな記述があればご教授下さい。

・ツリー全体表示


	【80349】Re:ファイルが大きくなる

総裁 - 19/1/30(水) 0:02 -


	引用なし

	パスワード

▼Jaka さん：
>手っ取り早く言うと、面倒くさがって余計な作業をしているからが多いと思う。

あっ、これやってました！
ありがとうございました。

・ツリー全体表示


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

105 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free