Results of 1 - 1 of about 13169 for 日付 (0.003 sec.)
- [[20150128135228]]
- #score: 2423
- @digest: f3a4ddb5998b4186a81790d63a2a495b
- @id: 67158
- @mdate: 2015-01-29T08:49:01Z
- @size: 10321
- @type: text/plain
- #keywords: 出コ (25798), mycriteria (12059), 記シ (5679), 出条 (4242), listbox1 (3939), mydata (3779), 元シ (3672), criteriarange (3498), copytorange (3420), xlfiltercopy (3160), advancedfilter (2554), textbox1 (2475), currentregion (2366), 抽出 (2186), 日付 (2051), entirecolumn (1826), inputbox (1546), aa (1483), ーフ (1434), clear (1370), columns (1289), commandbutton1 (1186), 2015 (1167), 指定 (1114), 別シ (1056), シー (1013), ダイ (996), 字列 (882), resize (862), range (842), フォ (820), コー (814)
- 『日付指定&文字列指定行を別シートに作成するマクロ』（のぞむ）
どうか助けてください。。 やりたいことは、以下の通りです。 Sheet1 元データに、 ・A列〜C列には、番号や各種項目。 ・D列以降に日付ごとの実験結果(数字&文字列）が入力されている。 日付と文字列を指定すると、 その日付列に指定した文字列入っている行だけの 新しい表を別シートに作成したい。（元データはそのままにしたい。） 指定する文字列は、ただ今のところ3つ〜5つ程です。 ＜具体例＞ （元データ） A B C D E F G 1 - - - 1 2 3 4 2 1234 X X DD BB CC DD 3 2345 X X AA CC AA BB 4 3456 X X DD BB AA DD 5 4567 X X AA CC DD CC 6 5678 X X AA AA CC DD 7 6789 X X DD BB AA BB 8 7890 X X BB BB BB AA 9 8901 X X AA CC CC BB . . ↓ 【日付】3日 【指定文字列】CCとAA と指定すると・・・ （別シート） A B C D E F G 1 - - - 1 2 3 4 2 1234 X X DD BB CC DD 3 2345 X X AA CC AA BB 4 3456 X X DD BB AA DD 5 5678 X X AA AA CC DD 6 6789 X X DD BB AA BB 7 8901 X X AA CC CC BB 日付と文字列の指定方法は、 ◆どこかに専用のセルを作成し、その横にマクロを登録したボタンを置いて、 専用セルに日付と文字列を入力した後、マクロ登録ボタンを押したら別シートが出来る。 ◆ユーザーフォームを利用し、 マクロ登録ボタンを押すとユーザーフォームが出てきて、 そこの欄に日付と文字列を入力して、実行ボタンを押すと別シートが出来る。 などをイメージしております。 可能であれば、今後の勉強のため、 ユーザーフォームを利用した方法をご教示頂けると幸いです。 何卒よろしくお願い致します。 ＜ 使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- 1行目の日付は 単純な数字で 1,2,3 なんですか? それとも日付型で表示書式で 1,2,3 になっているんですか? それと、1,2,3,・・・・と最後まで連続してあるのですか? それとも 1,2,4,5,8,10,25,・・・ といったように実験日だけになっているのですか? （β） 2015/01/28(水) 14:21 ---- 詳細設定（フィルターオプションの設定）のマクロ化はいかがでしょう。 （串） 2015/01/28(水) 14:25 ---- そうですね。ぴったりだと思います。 （β） 2015/01/28(水) 14:38 ---- 前提として 1行目が D1から右に、連続して、31まで入っているものとします。 元シート名、転記シート名は実際のものになおしてください。 Sub Test() Dim n As Long Dim s As String Dim v As Variant Dim r As Range Dim c As Range Do n = Application.InputBox("日付を1〜31でいれてください", Type:=1) If n = 0 Then Exit Sub 'キャンセルボタン If n >= 1 And n <= 31 Then Exit Do Loop s = Application.InputBox("抽出コードをいれてください。" & vbLf & "AA,BB,CC のように複数指定可能です。", Type:=2) If s = "False" Then Exit Sub v = Split(s, ",") Set r = Sheets("Sheet1").Range("A1").CurrentRegion '元シート With Sheets("Sheet2") '転記シート .Cells.Clear r.Rows(1).Copy .Range("A1") Set c = .Cells(1, r.Columns.Count + 2) c.Value = .Range("D1").Offset(, n - 1).Value c.Offset(1).Resize(UBound(v) + 1).Value = WorksheetFunction.Transpose(v) r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=c.CurrentRegion, _ CopyToRange:=.Rows(1).Resize(1, r.Columns.Count), Unique:=False c.EntireColumn.Clear .Select End With End Sub （β） 2015/01/28(水) 14:51 ---- 可能であれば、今後の勉強のため、 ユーザーフォームを利用した方法をご教示頂けると幸いです。 熱意はかうけど、一歩、一歩がいいのでは? そう思うけど、とりあえず、その勉強材料として。 UserForm1 のうえに TextBox1 と ListBox1 と CommandButton1 を配置。 ListBox1にコードが表示されるので選択。Ctrlを押しながら複数選択可能。 また、何かを選び、そのあとShiftキーを押して別のものを選ぶと、その範囲がすべて選ばれる。 TextBox1には 1〜31 の数字を入力。入力が終わったらCommandButton1をクリック。 「標準モジュール」 Sub Test2() UserForm1.Show End Sub 「ユーザーフォームモジュール」 Private Sub UserForm_Initialize() Dim dic As Object Dim c As Range Dim r As Range Set dic = CreateObject("Scripting.Dictionary") With Sheets("Sheet1").Range("A1").CurrentRegion '元シート Set r = .Cells.Offset(1, 3).Resize(.Rows.Count - 1, .Columns.Count - 3) For Each c In r dic(c.Value) = True Next End With With ListBox1 .MultiSelect = fmMultiSelectExtended .List = dic.keys End With Set dic = Nothing End Sub Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) Dim ok As Boolean Dim n As Variant With TextBox1 n = .Value If IsNumeric(n) Then If n >= 1 And n <= 31 Then ok = True End If If ok Then Exit Sub MsgBox "1〜31の数字で入れてください" Cancel = True .SelStart = 0 .SelLength = Len(.Value) End With End Sub Private Sub CommandButton1_Click() Dim i As Long Dim n As Long Dim s As String Dim v() As Variant Dim r As Range Dim c As Range Dim x As Long If Len(TextBox1.Value) = 0 Then MsgBox "日付が未入力です" Exit Sub End If n = TextBox1.Value ReDim v(1 To ListBox1.ListCount) For i = 1 To ListBox1.ListCount If ListBox1.Selected(i - 1) Then x = x + 1 v(x) = ListBox1.List(i - 1) End If Next If x = 0 Then MsgBox "抽出コードが選択されていません " Exit Sub End If ReDim Preserve v(1 To x) Set r = Sheets("Sheet1").Range("A1").CurrentRegion '元シート With Sheets("Sheet2") '転記シート .Cells.Clear r.Rows(1).Copy .Range("A1") Set c = .Cells(1, r.Columns.Count + 2) c.Value = .Range("D1").Offset(, n - 1).Value c.Offset(1).Resize(UBound(v)).Value = WorksheetFunction.Transpose(v) r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=c.CurrentRegion, _ CopyToRange:=.Rows(1).Resize(1, r.Columns.Count), Unique:=False c.EntireColumn.Clear .Select End With Unload Me End Sub （β） 2015/01/28(水) 15:43 ---- 串さん すぐにご回答頂きありがとうございます! 早速検索したところ以下の応用できそうなコードを発見しました! しかし、1行目に日付が入ってしまっているのですが、 この日付を同じように抽出条件シートに入力して指定するにはどのようにコードを書き直せばよろしいでしょうか…? (例）抽出条件シートに A B C D 1 日付 結果 B列項目 C列項目 2 1/1 AA 3 CC ========== Sub フィルタオプション（） Dim myData as range Dimmycriteria as range '「データ」シートのデータ範囲をmydataという変数に入れる Set myData=Worksheets("データ").range("A1").Currentregion '「抽出条件」シートの抽出条件の設定範囲をmyCriteriaという変数に入れる Set myCriteria=Worksheets("抽出条件").range("A1").Currentregion '「抽出」シートで With Worksheets（"抽出"） '抽出データをクリアする .Cells.Clear 'myDataをデータ範囲としてmyRangeを抽出条件として 'フィルタオプションで「抽出」シートのA3セル基準に抽出 myData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=myCriteria,_ CopyToRange:=Range("A3"),Unique:=False End with EndSub ========== βさん こんなにすぐに回答をいただけるとは…感謝です! 早速やってみたところばっちり動きました!! 大変恐縮ですが、以下の点について教えて頂けますでしょうか? ・日付表示が実は、1/1,1/2・・・というようにしたかったです。。。すみません。 どのようにコードを変更すればよろしいでしょうか? ・抽出コードを"AA"としたところ"AAA"も一緒に出てきてしまいます。。 完全一致でいいのですが、その場合はどうすればいいでしょうか＞＜? ・今回ご教示頂いた抽出コードを都度選ぶマクロと抽出コードを （たとえば）"AA"と"CC"を出す機会が圧倒的に多いので、日付指定だけする マクロも作りたい場合は、どこを省略すればいいでしょうか? 串さんからご提案頂いた、フィルターオプションのマクロ化にして デフォルトで"AA"と"CC"をセルに入力するようにしておけば解決するでしょうか? お忙しいところ本当に申し訳ございませんが、 初心者なものでどうか今一度ご教示お願い致します。 （のぞむ） 2015/01/29(木) 13:36 ---- 日付について、ダイアログで指定する日付のことをいってる? もし、そうじゃなく、シート上の日付の値のことなら、コードでは、日付をチェックせず、 ダイアログで入力された1〜31の数字から、D列以降のどの列かを判断しているので変更は不要。 抽出コードについては、もし、デフォルトが常に AA,BB だとして、それをダイアログ表示の際に、セットしてやり 変更なければ、そのままOKをおすというのは、いかがですか。 部分一致から、完全一致の件、了解。 で、以下で試してみてください。 Sub Test() Dim n As Long Dim s As String Dim v As Variant Dim r As Range Dim c As Range Dim x As Long Do n = Application.InputBox("日付を1〜31でいれてください", Type:=1) If n = 0 Then Exit Sub 'キャンセルボタン If n >= 1 And n <= 31 Then Exit Do Loop s = Application.InputBox("抽出コードをいれてください。" & vbLf & "AA,BB,CC のように複数指定可能です。", Default:="AA,BB", Type:=2) If s = "False" Then Exit Sub v = Split(s, ",") For x = LBound(v) To UBound(v) v(x) = "=""=" & v(x) & """" Next Set r = Sheets("Sheet1").Range("A1").CurrentRegion '元シート With Sheets("Sheet2") '転記シート .Cells.Clear r.Rows(1).Copy .Range("A1") Set c = .Cells(1, r.Columns.Count + 2) c.Value = .Range("D1").Offset(, n - 1).Value c.Offset(1).Resize(UBound(v) + 1).Value = WorksheetFunction.Transpose(v) r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=c.CurrentRegion, _ CopyToRange:=.Rows(1).Resize(1, r.Columns.Count), Unique:=False c.EntireColumn.Clear .Select End With End Sub （β） 2015/01/29(木) 13:57 ---- 詳細設定で実行されるなら、日付が項目名になります。 A 1 1/1 2 AA 3 CC 4 （串） 2015/01/29(木) 17:49... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201501/20150128135228.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97065 documents and 608342 words.
訪問者：