Excel VBA質問箱 IV

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

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


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

255 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77353】Re:［無題］

マルチネス - 15/7/26(日) 9:10 -


	引用なし

	パスワード

回答者への参考として。
MOUGとサロンにマルチ。

・ツリー全体表示


	【77352】［無題］

［名前なし］ - 15/7/26(日) 1:03 -


	引用なし

	パスワード

問１
K12とM12の値を比較する。
M12がK12以上の場合は「成立」とO12に表示する。そうでない場合は「不成立」と表示する。
問2
K7+M7+K12+M12の合計をM17に表示する。合計が20以上の場合は「評定値を越えました」とM20に表示。
越えない場合は「評定値です」と表示。

初心者です
いろいろ調べたのですがどうしても解けません…
解答をよろしくお願いします

・ツリー全体表示


	【77351】Re:comboboxのDropButtonClicを自動で開く

マナ - 15/7/24(金) 19:27 -


	引用なし

	パスワード

>↑この意味が理解できていません？？

あっ！意味わかりました。
こんなところに、リストが表示されていたなんて。

Excel2002ではどうだろうと思って
試してみたら気付きました。
これで、すっきりです。

ありがとうございました。

・ツリー全体表示


	【77350】Re:comboboxのDropButtonClicを自動で開く

マナ - 15/7/24(金) 19:03 -


	引用なし

	パスワード

▼β さん：

わかりやすい解説ありがとうございます。

>Initializeは、メモリーに呼びこまれただけでひょうじされていませんので　0 ですね。
>表示されて初めて実際の値が取得できます。

試してみて、実行のタイミングがよく理解できました。
何となく賢くなった気分です。

・ツリー全体表示


	【77349】Re:comboboxのDropButtonClicを自動で開く

マナ - 15/7/24(金) 19:00 -


	引用なし

	パスワード

▼ichinose さん：

いつもありがとうございます。

>Excel2010では、コンボボックスの位置と結構離れた位置でリストが表示されます。

↑この意味が理解できていません？？
ですが、

>Initailizeは、ユーザーフォームが表示される前に発生するイベントなので

今回のケースも含め、Activateではできて、
Initailizeでできないこともあるのは理解しました。

>Initailizeでうまくいかないときに　Activateで試してみる
>頭に入れておくと　よさそうですよね

そうですね。

・ツリー全体表示


	【77348】Re:２個ペアで並べ替えと番号をつけたい

マリモ - 15/7/24(金) 17:28 -


	引用なし

	パスワード

ありがとうございます。

そうですね。
勉強になりました。

・ツリー全体表示


	【77347】Re:２個ペアで並べ替えと番号をつけたい

マリモ - 15/7/24(金) 17:25 -


	引用なし

	パスワード

教えていただきまして
ありがとうございます。

今後、教えていただいたことを
実行できるように努めます。

以前も教えていただき
重ねて御礼申し上げます。

・ツリー全体表示


	【77346】Re:２個ペアで並べ替えと番号をつけたい

マリモ - 15/7/24(金) 17:20 -


	引用なし

	パスワード

ありがとうございます。
おかげですんなりできました。

以前もお世話になり
重ねて御礼申し上げます。

・ツリー全体表示


	【77345】Re:２個ペアで並べ替えと番号をつけたい

β - 15/7/24(金) 14:52 -


	引用なし

	パスワード

▼マリモさん：

提示されたコードのように、各2個のセルの転記を繰り返すと、膨大なコードになりますね。
アップされたコードでは、ペアが空白かどうかのチェックをしていませんので、それも加えると
すざましい長さのコードになりますね。

また、これはマクロ記録の宿命ですけど、Select/Selectionのてんこ盛りになります。

やはり、For/Next や Do/Loop といったループ処理が望ましいですね。
以下も、一例として。

Sub Test()
　　Dim x As Long
　　Dim i As Long
　　Dim j As Long
　　
　　Dim v As Variant
　　ReDim v(1 To Rows.Count - 1, 1 To 3)
　　
　　With Sheets("Sheet1")
　　　　For i = 2 To .Range("A1").CurrentRegion.Rows.Count
　　　　　　For j = 1 To Columns("OT").Column Step 2
　　　　　　　　If Not IsEmpty(.Cells(i, j)) Or Not IsEmpty(.Cells(i, j + 1)) Then
　　　　　　　　　　x = x + 1
　　　　　　　　　　If x > UBound(v, 1) Then
　　　　　　　　　　　　MsgBox "データが多すぎてシートに展開しきれません"
　　　　　　　　　　　　Exit Sub
　　　　　　　　　　End If
　　　　　　　　　　v(x, 1) = i - 1
　　　　　　　　　　v(x, 2) = .Cells(i, j).Value
　　　　　　　　　　v(x, 3) = .Cells(i, j + 1).Value
　　　　　　　　End If
　　　　　　Next
　　　　Next
　　End With
　　
　　With Sheets("Sheet2")
　　　　.Cells.ClearContents
　　　　.Range("A1:C1").Value = Array("番号", "経度", "緯度")
　　　　.Range("A2:C2").Resize(x).Value = v
　　　　.Select
　　End With
　　
End Sub

・ツリー全体表示


	【77344】Re:２個ペアで並べ替えと番号をつけたい

kanabun - 15/7/24(金) 12:58 -


	引用なし

	パスワード

失礼 >　　　　　If COP Then >　　　　　　　k = k + 1 >　　　　　　　r(y1, 1).Resize(y - y1 + 1).Value = i - 1 >　　　　　End If >　　　　　COP = False >　　　Next >　End With >　　 >End Sub は >　　　　　If COP Then >　　　　　　　k = k + 1 　　　　　　　r(y1, 1).Resize(y - y1 + 1).Value = k >　　　　　End If >　　　　　COP = False >　　　Next >　End With >　　 >End Sub こう書くつもりでした m(_ _)m

・ツリー全体表示


	【77343】Re:２個ペアで並べ替えと番号をつけたい

kanabun - 15/7/24(金) 12:56 -


	引用なし

	パスワード

▼マリモさん：マクロ記録をマクロにするときの参考にしてください Select , Selection を使ったマクロの記録のままは、とっても読みにくい。ので、マクロ記録の最初の方だけですけど、Select Selection をとってみると以下のようです。 Sub Macro1M() ' 　Sheets("Sheet2").Range("A1:C1").Value = Array("番号", "経度", "緯度") 　　 '(1行目) 　Sheets("Sheet1").Range("A2:B2").Copy Sheets("Sheet2").Range("B2") 　Sheets("Sheet1").Range("C2:D2").Copy Sheets("Sheet2").Range("B3") 　Sheets("Sheet2").Range("A2:A3").Value = 1 　 '(2行目) 　Sheets("Sheet1").Range("A3:B3").Copy Sheets("Sheet2").Range("B4") 　Sheets("Sheet1").Range("C3:D3").Copy Sheets("Sheet2").Range("B5") 　Sheets("Sheet2").Range("A4:A5").Value = 2 　　 '(以下同様) End Sub このまとめたものをみながら、２重ループで・外側２行目から最下行までループ・内側　1列目から最終列まで２列づつの構文に直してみました。 Sub MMcopy() 　Dim i As Long, j As Long　　'コピー元行、列番号　Dim n As Long, m As Long　　'コピー元最終行、最終列番号　Dim y As Long, y1 As Long　 'コピー先行番号　Dim k As Long　　　　　　　 'コピー先連番用　Dim COP As Boolean 　Dim r As Range 　　With Sheets("Sheet2") 　　　.UsedRange.Clear 　　　.Range("A1:C1").Value = Array("番号", "経度", "緯度") 　　　Set r = .Range("A1")　　　　'コピー先シート先頭セル　End With 　With Sheets("Sheet1") 　　　With .Range("A1").CurrentRegion 　　　　　n = .Rows.Count 　　　　　m = .Columns.Count 　　　End With 　　　y = 1 　　　For i = 2 To n 　　　　　For j = 1 To m Step 2 　　　　　　　If Not IsEmpty(.Cells(i, j).Value) Then 　　　　　　　　　y = y + 1 　　　　　　　　　If Not COP Then COP = True: y1 = y 　　　　　　　　　r(y, 2).Resize(, 2) = .Cells(i, j).Resize(, 2).Value 　　　　　　　End If 　　　　　Next 　　　　　If COP Then 　　　　　　　k = k + 1 　　　　　　　r(y1, 1).Resize(y - y1 + 1).Value = i - 1 　　　　　End If 　　　　　COP = False 　　　Next 　End With 　　 End Sub

・ツリー全体表示


	【77342】Re:２個ペアで並べ替えと番号をつけたい

ウッシ - 15/7/24(金) 12:28 -


	引用なし

	パスワード

こんにちは

偶数個じゃない場合の最後の1個もセットするとして、

Sub test()
　　Dim i　 As Long
　　Dim j　 As Long
　　Dim k　 As Long
　　Dim n　 As Long
　　Dim sh1 As Worksheet
　　Dim sh2 As Worksheet
　　Dim t　 As Range
　　
　　n = Range("OT1").Column
　　
　　Set sh1 = Worksheets("Sheet1")
　　Set sh2 = Worksheets("Sheet2")
　　
　　With sh2
　　　　.Cells.Delete
　　　　.Range("A1:C1").Value = Array("番号", "経度", "緯度")
　　　　k = 1
　　　　For i = 2 To sh1.Range("A1").CurrentRegion.Rows.Count
　　　　　　Set t = sh1.Range(sh1.Cells(i, 1), sh1.Cells(i, n + 1))
　　　　　　For j = 1 To n
　　　　　　　　If t(1, j) <> "" Then
　　　　　　　　　　.Range("A" & .Rows.Count).End(xlUp).Offset(1) = k
　　　　　　　　　　.Range("A" & .Rows.Count).End(xlUp).Offset(, 1) = t(1, j)
　　　　　　　　　　Do
　　　　　　　　　　　　If j > n Then Exit Do
　　　　　　　　　　　　j = j + 1
　　　　　　　　　　Loop While t(1, j) = ""
　　　　　　　　　　.Range("A" & .Rows.Count).End(xlUp).Offset(, 2) = t(1, j)
　　　　　　　　End If
　　　　　　Next
　　　　　　k = k + 1
　　　　Next
　　End With
End Sub

・ツリー全体表示


	【77341】２個ペアで並べ替えと番号をつけたい

マリモ - 15/7/24(金) 10:51 -


	引用なし

	パスワード

お世話になります
マリモと申します。

A列B列、C列D列・・・OT列までのペアで中には空欄もありまして
空欄は飛ばして記入のあるペアをB列c列に並べ替えをし、
その際に同じ行に書いてあったものは同じ番号をつけたいのですが、
量が多く手作業では追いつかないのでご相談させていただきました。

下記に記録例を載せます。

Sub Macro1()
'
' Macro1 Macro
'

'
　　Sheets("Sheet2").Select
　　Range("A1").Select
　　ActiveCell.FormulaR1C1 = "番号"
　　ActiveCell.Characters(1, 2).PhoneticCharacters = "バンゴウ"
　　Range("B1").Select
　　ActiveCell.FormulaR1C1 = "経度"
　　ActiveCell.Characters(1, 2).PhoneticCharacters = "ケイド"
　　Range("C1").Select
　　ActiveCell.FormulaR1C1 = "緯度"
　　ActiveCell.Characters(1, 2).PhoneticCharacters = "イド"
　　Range("D1").Select
　　Sheets("Sheet1").Select
　　Range("A2:B2").Select
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("B2").Select
　　ActiveSheet.Paste
　　Sheets("Sheet1").Select
　　Range("C2:D2").Select
　　Application.CutCopyMode = False
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("B3").Select
　　ActiveSheet.Paste
　　Range("A2").Select
　　Application.CutCopyMode = False
　　ActiveCell.FormulaR1C1 = "1"
　　Range("A3").Select
　　ActiveCell.FormulaR1C1 = "1"
　　Range("B3").Select
　　Sheets("Sheet1").Select
　　Range("A3:B3").Select
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("B4").Select
　　ActiveSheet.Paste
　　Sheets("Sheet1").Select
　　Range("C3:D3").Select
　　Application.CutCopyMode = False
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("B5").Select
　　ActiveSheet.Paste
　　Range("A4").Select
　　Application.CutCopyMode = False
　　ActiveCell.FormulaR1C1 = "2"
　　Range("A5").Select
　　ActiveCell.FormulaR1C1 = "2"
　　Range("B5").Select
　　Sheets("Sheet1").Select
　　Range("A4:B4").Select
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("B6").Select
　　ActiveSheet.Paste
　　Sheets("Sheet1").Select
　　Range("C4:D4").Select
　　Application.CutCopyMode = False
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("B7").Select
　　ActiveSheet.Paste
　　Sheets("Sheet1").Select
　　Range("E4:F4").Select
　　Application.CutCopyMode = False
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("B8").Select
　　ActiveSheet.Paste
　　Sheets("Sheet1").Select
　　Range("G4:H4").Select
　　Application.CutCopyMode = False
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("B9").Select
　　ActiveSheet.Paste
　　Sheets("Sheet1").Select
　　Range("I4:J4").Select
　　Application.CutCopyMode = False
　　Selection.Copy
　　Sheets("Sheet2").Select
　　Range("B10").Select
　　ActiveSheet.Paste
　　Range("A6").Select
　　Application.CutCopyMode = False
　　ActiveCell.FormulaR1C1 = "3"
　　Range("A6").Select
　　Selection.AutoFill Destination:=Range("A6:A10"), Type:=xlFillDefault
　　Range("A6:A10").Select
　　Range("C11").Select
End Sub

よろしくお願いいたします。

・ツリー全体表示


	【77340】Re:application file serch

ichinose - 15/7/24(金) 7:00 -


	引用なし

	パスワード

▼もぐらさん：
>超初心者ですが、宜しくお願いします。
>FileSearch()
>　　Dim FSO As Object, Folder As Variant
>　　Set FSO = CreateObject("Scripting.FileSystemObject")
>　　For Each Folder In FSO.GetFolder("G:\").SubFolders
>　　　　Debug.Print Folder.Path
>　　Next Folder
>ふるいバージョンのマクロが動作しないので、これを使って、読みにいきたいのですが、記述がわかりません＞＜　
>もともとは
>Set fs = Application.FileSearch 'ﾌｧｲﾙの有無
>With fs
>　　.LookIn = "G:\"
>　　.Filename = "*." & n
>　　If .Execute(SortBy:=msoSortByFileName, _
>　　　　　　SortOrder:=msoSortOrderAscending) > 0 Then
>　　　　For j = 1 To .FoundFiles.Count
>　　　　　　m = m + 1
>　　　　Next j
>こんなふうになっていました。
>御教授お願いいたします。。

FSOの使い方は、このサイトでFSOで検索すれば、沢山事例が表示されます。

www.happy2-island.com/vbs/cafe02/capter00201.shtml

www.atmarkit.co.jp/ait/articles/0804/09/news153.html

この辺りで調べることから　はじめてください。

>もともとは

から提示されたFileSearchを使ったコードは、何が出来るコードになっているか
記述してください

・ツリー全体表示


	【77339】Re:comboboxのDropButtonClicを自動で開く

ichinose - 15/7/24(金) 6:00 -


	引用なし

	パスワード

>Activateイベントでは、可能でも　Initializeでは不可なことって
>他にもいくつかあったはずですよ、今は　思い出せませんが・・・。
思い出した事例

ユーザーフォーム（UserForm1）にテキストボックスを二つ（TextBox1、TextBox2）
配置してください。

UserForm1を表示させる際に　条件によって　フォーカスするテキストボックスを変えたい場合を想定します。

事例では、時刻の秒単位が30秒より大きかった場合、TextBox2にフォーカスする

という仕様です。
尚、表示は　モードレスで表示するとします。

1

UserForm1のモジュールに

Private Sub UserForm_Initialize()
　　If Second(Now()) > 30 Then TextBox2.SetFocus
End Sub

標準モジュールに

Sub test1()
　　UserForm1.Show vbModeless
End Sub

２

UserForm1のモジュールに

Private Sub UserForm_Activate()
　　If Second(Now()) > 30 Then TextBox2.SetFocus
End Sub

標準モジュールに

Sub test2()
　　UserForm1.Show vbModeless
End Sub

1では、UserForm1の表示時に　Textbox2にフォーカスをあてることが出来ませんが、

2では　可能になっています。

Initailizeでうまくいかないときに　Activateで試してみる

こんな鉄則（昔、算数の参考書によくありましたね　こういうの）を
頭に入れておくと　よさそうですよね

・ツリー全体表示


	【77338】Re:comboboxのDropButtonClicを自動で開く

β - 15/7/24(金) 2:50 -


	引用なし

	パスワード

実際に、実装レベルで、InitializeとActivateで、どうなっているかはうかがい知れませんが
ユーザーフォームが表示されて機能する部分と表示前に機能する部分は、なんとなく勘（？）。
勘がはずれても、やってみれば、あぁ、こうなんだと。

SendKeysに関しては、ichinoseさんから回答があるように、
実行はキュー（っていうんでしょうか？）に入っていて、表示されたときに、
キーストロークがそのフォームにぶつけられるんでしょうね。

たとえば、StartupPositionが１のユーザーフォームで

Private Sub UserForm_Initialize()
　　MsgBox "Init:" & Me.Left
End Sub

Private Sub UserForm_Activate()
　　MsgBox "Act:" & Me.Left
End Sub

Initializeは、メモリーに呼びこまれただけでひょうじされていませんので　0 ですね。
表示されて初めて実際の値が取得できます。

また、

Private Sub UserForm_Initialize()
　　MsgBox "Init"
　　Unload Me
End Sub

これだと　エラーになりますね。

Private Sub UserForm_Activate()
　　MsgBox "Act"
　　Unload Me
End Sub

Initializeが完了して初めて Unload が可能になるようです。

また、

Private Sub UserForm_Initialize()
　　MsgBox "Init"
　　Me.Hide
End Sub

Private Sub UserForm_Activate()
　　MsgBox "Act"
　　Me.Hide
End Sub

Initialize では表示されていないので、Hideもなにも、あったものではないんですが
実際にInitializeでは機能していないことが、Activateで表示されたときにわかりますね。

・ツリー全体表示


	【77337】Re:comboboxのDropButtonClicを自動で開く

ichinose - 15/7/23(木) 23:57 -


	引用なし

	パスワード

▼マナさん：
>▼β さん：
>
>解決したようなので、よろしければ、関連で教えてください。
>Activateでなく、Initailizeだとできないのですが
>そういうものでしょうか。
Excel2010では、コンボボックスの位置と結構離れた位置でリストが表示されます。
Initailizeは、ユーザーフォームが表示される前に発生するイベントなので
このような不具合になるのでしょうねえ！！

Sendkeysでも　プロシジャー内で　"%{Down}"が実行されるように

SendKeys "%{Down}", True とすると、
ComboBox1.DropDownと同じ結果になります。

SendKeys "%{Down}"　だと、ユーザーフォームが表示後に"%{Down}"が実行されますから・・・。

Activateイベントでは、可能でも　Initializeでは不可なことって
他にもいくつかあったはずですよ、今は　思い出せませんが・・・。

・ツリー全体表示


	【77336】Re:comboboxのDropButtonClicを自動で開く

マナ - 15/7/23(木) 20:19 -


	引用なし

	パスワード

▼β さん：

解決したようなので、よろしければ、関連で教えてください。
Activateでなく、Initailizeだとできないのですが
そういうものでしょうか。

SendKeysでは、できるのですが、
私が勘違いしているだけで、当たり前のこと？

Private Sub UserForm_Initialize()

　　ComboBox1.List = Array("a", "b")
'　　ComboBox1.SetFocus
　　ComboBox1.DropDown
'　　SendKeys "%{Down}"
'　　Application.OnTime Now + TimeValue("00:00:1"), "drop"
　　
End Sub

・ツリー全体表示


	【77335】application file serch

もぐら

- 15/7/23(木) 16:39 -


	引用なし

	パスワード

超初心者ですが、宜しくお願いします。
FileSearch()
　　Dim FSO As Object, Folder As Variant
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　For Each Folder In FSO.GetFolder("G:\").SubFolders
　　　　Debug.Print Folder.Path
　　Next Folder
ふるいバージョンのマクロが動作しないので、これを使って、読みにいきたいのですが、記述がわかりません＞＜　
もともとは
Set fs = Application.FileSearch 'ﾌｧｲﾙの有無
With fs
　　.LookIn = "G:\"
　　.Filename = "*." & n
　　If .Execute(SortBy:=msoSortByFileName, _
　　　　　　SortOrder:=msoSortOrderAscending) > 0 Then
　　　　For j = 1 To .FoundFiles.Count
　　　　　　m = m + 1
　　　　Next j
こんなふうになっていました。
御教授お願いいたします。。

・ツリー全体表示


	【77334】Re:comboboxのDropButtonClicを自動で開く

tomi - 15/7/23(木) 4:06 -


	引用なし

	パスワード

▼β さん：
>▼tomi さん：
>
>こんなことでしょうか？
>
>Private Sub UserForm_Activate()
>　　ComboBox1.DropDown
>End Sub
ありがとうございました。解決しました。

・ツリー全体表示


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

255 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free