Excel VBA質問箱 IV

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

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


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

254 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77358】Re:指定期間の絞り込み

Jaka - 15/7/30(木) 16:26 -


	引用なし

	パスワード

私的には、これが万能だと思っています。

Dim 開始日 As String
Dim 終了日 As String

開始日 = format(Worksheets("集計").Range("F2"),"yyyy/mm/dd")
終了日 = format(Worksheets("集計").Range("G2"),"yyyy/mm/dd")

・ツリー全体表示


	【77357】指定期間の絞り込み

なつ - 15/7/30(木) 15:11 -


	引用なし

	パスワード

こんにちは。
開始日（例：2015/7/30）から終了日（例：2015/8/14）までのデータを
絞り込みたいのですが、ボタンをクリックすると空白で返ってきます。
どうすれば上手く絞れ込めるかご教授をお願いいたします。

D列に「日付」データが入っています。
F2に開始日、G2に終了日が入っています。

お手数ですが、宜しくお願いします。

Private Sub Cmd期間_Click()
Dim 開始日 As Date
Dim 終了日 As Date

開始日 = Worksheets("集計").Range("F2")
終了日 = Worksheets("集計").Range("G2")

Worksheets("集計").Range("A3:L2000").AutoFilter Field:=4, _
Criteria1:=">=" & 開始日, _
Operator:=xlAnd, _
Criteria2:="<=" & 終了日
End Sub

・ツリー全体表示


	【77356】Re:文字列を数値に変換

tomi - 15/7/30(木) 11:57 -


	引用なし

	パスワード

▼kanabun さん：
>▼tomi さん：
>>よろしくお願いします。文字列等のものを数字に変換したいと思います。
>>　問題は小数点を含むものです。
>>　CsngやCdbl等で変換を使用してもうまくできません（整数になっていしまいます）
>>　たとえば"281.3"を変換して　数字の　281．3にしたいのです。
>
>Csngは精度がよくないので、Cdblを使ってください。
>他には Val関数とか？
>
>　Debug.Print CDbl("281.3")　 '→ 281.3 に変換される
>　Debug.Print Val("1234.56")　'→ 1234.56 に変換される
>　
>　On Error Resume Next
>　Debug.Print CDbl("281. 3")　 '→ エラー
>　Debug.Print Val("1234. 56")　'→ 1234.56 に変換される
>　
>　Debug.Print CDbl("281。3")　 '→ エラー
>　Debug.Print Val("1234。56")　'→ 整数 1234 に変換される
ありがとうございました。解決しました。

・ツリー全体表示


	【77355】Re:文字列を数値に変換

kanabun - 15/7/30(木) 11:06 -


	引用なし

	パスワード

▼tomi さん： >よろしくお願いします。文字列等のものを数字に変換したいと思います。 >　問題は小数点を含むものです。 >　CsngやCdbl等で変換を使用してもうまくできません（整数になっていしまいます） >　たとえば"281.3"を変換して　数字の　281．3にしたいのです。 Csngは精度がよくないので、Cdblを使ってください。他には Val関数とか？　Debug.Print CDbl("281.3")　 '→ 281.3 に変換される　Debug.Print Val("1234.56")　'→ 1234.56 に変換される　　On Error Resume Next 　Debug.Print CDbl("281. 3")　 '→ エラー　Debug.Print Val("1234. 56")　'→ 1234.56 に変換される　　Debug.Print CDbl("281。3")　 '→ エラー　Debug.Print Val("1234。56")　'→ 整数 1234 に変換される

・ツリー全体表示


	【77354】文字列を数値に変換

tomi - 15/7/30(木) 9:07 -


	引用なし

	パスワード

よろしくお願いします。文字列等のものを数字に変換したいと思います。
　問題は小数点を含むものです。
　CsngやCdbl等で変換を使用してもうまくできません（整数になっていしまいます）
　たとえば"281.3"を変換して　数字の　281．3にしたいのです。
　よろしくお願いします。

・ツリー全体表示


	【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で試してみる

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

・ツリー全体表示


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

254 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free