hige_082 の回答履歴

セルが左ダブルクリックされると、そのセルが色づけされるプログラムがあります。 しかし、そのセル内に複数行の文字列が入力されている場合、そのセルを選択時、 そのセル内の文字列が数式バーにも複数行表示されますが、数式バーとセルが重 なってしまう時、左クリックが優先されてしまうため、左ダブルクリックが認識 できません。どうすれば、この問題を解決できるのでしょうか。 教えて下さい。

VBAを使って =A2<>0の条件付書式の入ったセルが 黒塗りのときをロックしたいと思い セルの状態を調べたいのですが FormatConditionsを使えばいいのかと想うのですが 使い方がイマイチわかりません。 たとえば 黒で塗りつぶしたセルを探そうと想ったときは locked_col = RGB(0, 0, 0) cell_col = Worksheets("Sheet1").Cells(j, i).Interior.Color 'セルが黒塗りの場合ロックする If Not cell_col = locked_col Then Cells(j, i).Locked = False End If っていう風にはできないのでしょうか？ 知恵をおかしください

エクセル2003マクロ：１日ごとに書き換えるシートの合計を１ヶ月集計のシートにコピー、貼付けのようなことをすることを教えてください。 １日ごとに書き換えるシートと、１ヶ月集計するシートがあります。 １日ごとにデータをまとめて、そのデータを印刷し、そのデータの合計を１ヶ月単位で集計しているのですが、それをマクロにする方法が分かりません。 １日ごとに書き換えるシートはテンプレートになっていて、日付を書き換えて同じシートを使います。 そこで例えば、シート１（１日ごとに書き換えるシート）のA1:E1のデータを、シート２（１ヶ月単位で集計するシート）の１日なら１日の場所（例えばシート２のA1:E1）、２日なら２日の場所（例えばシート２のA2:E2）にコピー、貼付けのようなことはできるのでしょうか。 まとめてやるのではなく、１日ごとに日付の場所に。というようにしたいです。 分かりづらいかもしれませんが、よろしくお願いします。

エクセルＶＢＡでSheet2の指定のセルをコピーして、 Sheet1にある表の中の指定の列の空白セルを探して貼り付けるＶＢＡを作成したいのですが、うまく出来ません。 Sheet1の表は１行目、２行目は見出しの項目が並んでいます。 ３行目から５０行目までは値を入力するようになっていて、 ５１行目はそれらをの集計が表示されるようになっています。 下記のＶＢＡを作成したら３行目～５０行目までの空欄に貼り付けず、 ５２行目に貼り付けてしまいます。 ----------------------------------------------------------- Sheets("Sheet2").Range("B6").CurrentRegion.Copy Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = False ------------------------------------------------------------ 修正して頂けないでしょうか？ 宜しくお願いします。

Windows7 Excel2007 使用しているマクロ初心者です。 マクロ記録で、次の２個のスクリプトをつくりました。 二つとも正常に実行できています。 しかし、このコードは　.SetRange Range("A3:N26")の部分をいちいち手動で変更しなくてはなりません。 この部分を自動で設定し、しかもどちらの一覧表でも使えるコードにしたいです。 どう修正したらよろしいでしょうか？　.Header = xlNo以下のコード省略できますか？ Sub 一覧表１のソート() Range("B2").Select Worksheets("一覧表1").Sort.SortFields.Clear Worksheets("一覧表1").Sort.SortFields.Add Key:=Range("B2"), SortOn _ :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Worksheets("一覧表1").Sort .SetRange Range("A3:N26") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub ---------------------------------------------------- Sub 一覧表２のソート() Range("B2").Select Worksheets("一覧表２").Sort.SortFields.Clear Worksheets("一覧表２").Sort.SortFields.Add Key:=Range("B2"), SortOn _ :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Worksheets("一覧表２").Sort .SetRange Range("A3:P28") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub

事務関係で営業成績をまとめるVBAを作成しています。 ２点程困っている部分があり質問させて頂きます。 内容としては、５つの部署が同フォーマットのエクセルファイルで営業の報告してきます。 そのエクセルファイルには「営業一覧」というシートがあり、 B列に「新規獲得」とあるもののみオートフィルタで抽出し、 C列の「会社名」のみを別ファイルのSheet2にまとめたいと思っています。 以下プログラムの一部になります。 ※filelist = 各部署のエクセルファイル For i = 0 To 5 Workbooks.Open folderspec & "￥" & file_list(i).ReadOnly Workbooks(file_list(i)).Worksheets("営業一覧").Active With Workbooks(file_list(i)).Worksheets("営業一覧").Range("A1") .AutoFilter Field = 2, Criterial = "新規獲得" Range("C2").Select Range(Selection, Selection.End(xlLastCell)).Select Selection.Copy main_workbok.Worksheets("Sheet2").Cells(cnt_cpy, 1) .AutoFilter End With cnt_cpy = cnt_cpy + 1 Workbooks(file_lst(i)).Close SaveChanges:=False Next i (1)現在以下で1004エラーが発生し、別シートに貼り付けで出来ないといわれています。 Selection.Copy main_workbok.Worksheets("Sheet2").Cells(cnt_cpy, 1) おそらくですが、コピーする領域がひろすぎて65535？を超過してしまっているのでは ないかと思います。 この場合抽出領域だけを選択し、コピーするにはどうしたらよいでしょうか。 また、フィルタ結果が一件も無い場合はどうしたらよいでしょうか。 (2)このプログラムでは、１つ目の部署に新規獲得会社が２件、また２つ目の部署に新規獲得会社が２件 存在していた場合、cnt_cpyがうまく件数をカウント出来ず、 ４件ではなく３件が表示されてしまいます。(つまり１つ目の部署の２件目がきえてしまう。) この様な内容を解消するにはcnt_cpyをどのように扱えばよいでしょうか？ わかりずらい記述もありますが、困っておりますので、 なにか情報を頂けましたら幸いです。よろしくお願いいたします。

ユーザーフォームを開く時は UserForm1.Showですが 閉じる時は？ UserForm1.Close だとコンパイルエラーになります。 End にするしかないですか？

Windows7 Excel2007 使用しているマクロ初心者です。 マクロ記録で、次の２個のスクリプトをつくりました。 二つとも正常に実行できています。 しかし、このコードは　.SetRange Range("A3:N26")の部分をいちいち手動で変更しなくてはなりません。 この部分を自動で設定し、しかもどちらの一覧表でも使えるコードにしたいです。 どう修正したらよろしいでしょうか？　.Header = xlNo以下のコード省略できますか？ Sub 一覧表１のソート() Range("B2").Select Worksheets("一覧表1").Sort.SortFields.Clear Worksheets("一覧表1").Sort.SortFields.Add Key:=Range("B2"), SortOn _ :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Worksheets("一覧表1").Sort .SetRange Range("A3:N26") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub ---------------------------------------------------- Sub 一覧表２のソート() Range("B2").Select Worksheets("一覧表２").Sort.SortFields.Clear Worksheets("一覧表２").Sort.SortFields.Add Key:=Range("B2"), SortOn _ :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Worksheets("一覧表２").Sort .SetRange Range("A3:P28") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub

事務関係で営業成績をまとめるVBAを作成しています。 ２点程困っている部分があり質問させて頂きます。 内容としては、５つの部署が同フォーマットのエクセルファイルで営業の報告してきます。 そのエクセルファイルには「営業一覧」というシートがあり、 B列に「新規獲得」とあるもののみオートフィルタで抽出し、 C列の「会社名」のみを別ファイルのSheet2にまとめたいと思っています。 以下プログラムの一部になります。 ※filelist = 各部署のエクセルファイル For i = 0 To 5 Workbooks.Open folderspec & "￥" & file_list(i).ReadOnly Workbooks(file_list(i)).Worksheets("営業一覧").Active With Workbooks(file_list(i)).Worksheets("営業一覧").Range("A1") .AutoFilter Field = 2, Criterial = "新規獲得" Range("C2").Select Range(Selection, Selection.End(xlLastCell)).Select Selection.Copy main_workbok.Worksheets("Sheet2").Cells(cnt_cpy, 1) .AutoFilter End With cnt_cpy = cnt_cpy + 1 Workbooks(file_lst(i)).Close SaveChanges:=False Next i (1)現在以下で1004エラーが発生し、別シートに貼り付けで出来ないといわれています。 Selection.Copy main_workbok.Worksheets("Sheet2").Cells(cnt_cpy, 1) おそらくですが、コピーする領域がひろすぎて65535？を超過してしまっているのでは ないかと思います。 この場合抽出領域だけを選択し、コピーするにはどうしたらよいでしょうか。 また、フィルタ結果が一件も無い場合はどうしたらよいでしょうか。 (2)このプログラムでは、１つ目の部署に新規獲得会社が２件、また２つ目の部署に新規獲得会社が２件 存在していた場合、cnt_cpyがうまく件数をカウント出来ず、 ４件ではなく３件が表示されてしまいます。(つまり１つ目の部署の２件目がきえてしまう。) この様な内容を解消するにはcnt_cpyをどのように扱えばよいでしょうか？ わかりずらい記述もありますが、困っておりますので、 なにか情報を頂けましたら幸いです。よろしくお願いいたします。

　このサイトのお力により以下のプロシージャができました。 折角作っていただいたのですが、処理枚数が増えたため１ファイルに1日分だったのが３日分（６ファイル）をコピーすることになってしまいました。どのようにしたらよいでしょうか、お分かりの方いらっしゃいましたらよろしくお願いします。 　現状は、あるフォルダー内のファイル970303日報1、970303日報2を開いて、新しいブックに貼りつけて保存する。次に970304日報1、970304日報2を開いて新しいブックに貼りつけて保存するという作業の繰り返しです。 　これを、970303日報1,2　970304日報1,2　970305日報1,2の3日分を新しいブックにコピーして保存する。次に970306日報1,2　970307日報1,2　970308日報1,2を新しいブックにコピーして保存する。これの繰り返しをしたいのですがどうしたらよいでしょうか。 　ファイルのコピーする範囲は一定です。貼り付けるブックのセルは １日目の日報１がA1、日報2がL5、2日目の日報1がA40、日報2がL44 3日目の日報1がA79、日報2がL83となります。 　すみませんよろしくお願いします。 Sub copybook11() Dim myPath As String 'このブックのパス Dim DataFile As String 'Dir()で開くブック名 Dim copybook As Workbook '開いたブック Dim NewBook As String '新しいブック Dim NewFileName As String '新しいファイル名 myPath = ThisWorkbook.Path & "\" DataFile = Dir(myPath & "*.xls", vbNormal) Do While DataFile <> "" If DataFile <> ThisWorkbook.Name And InStr(1, 　　　　DataFile, "日報") > 0 Then Set copybook = Application.Workbooks.Open 　　　　(Filename:=myPath & DataFile, ReadOnly:=True) Select Case Mid(DataFile, InStr(1, DataFile, "日 　　　　　報"), 3) Case "日報1" Workbooks.Add NewBook = ActiveWorkbook.Name copybook.ActiveSheet.Range("A1:K38").copy Workbooks(NewBook).ActiveSheet.Range 　　　　　　　　　　("A1").PasteSpecial paste:=xlAll Application.CutCopyMode = False copybook.Close Case "日報2" copybook.ActiveSheet.Range 　　　　　　　　　　("B3:K36,T3:U36").copy Workbooks(NewBook).ActiveSheet.Range 　　　　　　　　　　("L5").PasteSpecial paste:=xlAll Application.CutCopyMode = False copybook.Close NewFileName = Format(Workbooks 　　(NewBook).ActiveSheet.Range("k2").Value, "yyyymmdd") & "日 　　　報.xls" Workbooks(NewBook).SaveAs Filename:=myPath 　　　　　　　　　　& NewFileName, FileFormat:=xlExcel8 Application.DisplayAlerts = True Workbooks(NewFileName).Close End Select End If DataFile = Dir Loop End Sub

VBA素人です。教えてください。 添付シートのようなデータがあるとします。 ユーザーフォームにテキストボックスを作成し、 (1)シート内の型式を型式BOXに手入力で入れる (2)良品数を手入力で入れる (3)日付を手入力で入れる（初期設定はDateをかえす） (1)～(3)を入力し、入力コマンドボタンで型式と日付がFINDするセルに 良品数を入れるコードを下記作成しました。 シート内に対象の型式、日付があれば、うまく作動するのですが、 型式、日付両方が無い場合、もしくはどちらか片方が無い場合は、 うまく作動しません。 おそらく型式FIND～IF、日付FIND～IFの使い方が悪いと思います。 型式がシート内に無ければ、型式エラーとしマクロを抜ける。 型式があり、日付が無ければ、日付エラーでマクロを抜けるコードを教えてください。 なお、型式を手入力で入れていますが、シート内の（"B:B"）セルを選択すると自動で型式テキストボックスに入れる方法もご教示下さい。 Private Sub UserForm_Initialize() 型式BOX = ""'テキストボックス 良品BOX = ""'テキストボックス 日付BOX = Date'テキストボックス 型式BOX.SetFocus End Sub Private Sub 入力_Click() Application.ScreenUpdating = False Application.EnableEvents = False If Len(型式BOX.Value) = 0 Then MsgBox "型式が未選定です" Cancel = True ElseIf Len(良品BOX.Value) = 0 Then MsgBox "良品が未入力です" Cancel = True ElseIf Len(日付BOX.Value) = 0 Then MsgBox "日付が未入力です" Cancel = True Else Dim a As Variant a = 型式BOX.Value Dim b As Date b = 日付BOX.Value On Error Resume Next Columns("B:B").Select ActiveSheet.Cells.Find(a, , , xlWhole, xlByRows, xlNext, False).Select X = ActiveCell.Row If Err = 91 Then MsgBox (prompt) & a & "の型式はありません", _ (vbOKOnly + vbExclamation), ("型式検索結果") Err.Clear End If On Error Resume Next Rows("1:1").Select ActiveSheet.Cells.Find(b, , , xlWhole, xlByColumns, xlNext, False).Select Y = ActiveCell.Column If Err = 91 Then MsgBox (prompt) & b & "の日付はありません", _ (vbOKOnly + vbExclamation), ("日付検索結果") Err.Clear 　 End If Cells(X, Y) = 良品BOX.Value End If End Sub

Excel2003を使っています。 先日パソコンをリカバリしたのですが、リカバリ前にはあったExcelのフォントが現在は大量になくなっており、今までに作ったものの「AR隷流体M」で打った文字がゴシック体に変わっていました。 リカバリ前にも、自分でフォントをインストールした覚えがないので、OfficeかXPのディスクの中か、Windowsの更新で知らぬうちに入ったものだと思うのですが、どなかたかご存知でしたらお教えください。お願いいたします。

Excelで １．あるセルを選択あるいは複数のセルを選択。 ２．ボタンをクリックすると、実線のマルで文字を囲む。 　　（線の太さはマクロ内で０．７５を指定） ３．もう一回ボタンをクリックすると点線のマルで文字を囲む。 ４．もう一回クリックすると文字はマルで囲まれない。 ５．以降、ボタンをクリックすると２．～４．がくり返される。 １．はマウスでセルをクリックする操作をしますが、２．～５． はマクロを設定したボタンをクリックする操作です。 選択するセルは、離れたセルを複数選択していてもうまく文字を 囲むマクロです。 このボタンに設定するマクロを教えていただけないでしょうか。 （使い方としては、表の上部のセルにボタンをレイアウトし、 　ボタンにマクロを設定し、表の中のセルをクリックしたあと 　マクロを設定したボタンをクリックすると、選択したセルが 　マルで囲まれる。そんな操作です。） 選択するセルに入力されている文字は、 「全角１文字」「全角２文字」「半角１文字」「半角２文字」の ケースがあります。 できれば、マクロの中でこの４つのケースでもうまくマルあるいは 楕円で文字を囲む処理を一つのマクロでできると助かります。 Excel97でもこのマクロを使います。 難しい質問で申し訳ありません。宜しくお願い致します。

Excel2003での並べ替えについてお教えください。 下記のようなデータを、 行|列　A --|-------------- １|（株）あああ ２|（有）ああう　 ３|　ああい ４|　あああ 行|列　A --|-------------- １|（株）あああ ２|　あああ　 ３|　ああい　 ４|（有）ああう 上記のように（株）、（有）など関係なく、 社名のみをみて、並べ替えをしたいです。 どのようにすればよいでしょうか？ よろしくお願いします。

VBA初心者です。 VBAでEXCELの行の値を累計したいのですが、プログラムの仕方がわかりません。 どなたかわかる方教えてください。 　　　 A　　 　B　　 C　　　 D　　　E　・・・・ 1　　1000　3000　2000　4000　3000　 2　　2000　5000　1000　3000　2000　 3　　4000　2000　3000　1000　5000　　 : 　　　 実行結果 　　 　A　　　 B 　　 C　　 　D 　　 E　　・・・・ 1　　1000　4000　6000　10000　13000 2　　2000　7000　8000　11000　13000　　　←行の値の累計 3　　4000　6000　9000　10000　15000 : 行と列はたくさんあって、最後のセルまで累計する方法を教えていただけるとありがたいです。 どうぞよろしくお願いします。m(_ _)m

Excelで １．あるセルを選択あるいは複数のセルを選択。 ２．ボタンをクリックすると、実線のマルで文字を囲む。 　　（線の太さはマクロ内で０．７５を指定） ３．もう一回ボタンをクリックすると点線のマルで文字を囲む。 ４．もう一回クリックすると文字はマルで囲まれない。 ５．以降、ボタンをクリックすると２．～４．がくり返される。 １．はマウスでセルをクリックする操作をしますが、２．～５． はマクロを設定したボタンをクリックする操作です。 選択するセルは、離れたセルを複数選択していてもうまく文字を 囲むマクロです。 このボタンに設定するマクロを教えていただけないでしょうか。 （使い方としては、表の上部のセルにボタンをレイアウトし、 　ボタンにマクロを設定し、表の中のセルをクリックしたあと 　マクロを設定したボタンをクリックすると、選択したセルが 　マルで囲まれる。そんな操作です。） 選択するセルに入力されている文字は、 「全角１文字」「全角２文字」「半角１文字」「半角２文字」の ケースがあります。 できれば、マクロの中でこの４つのケースでもうまくマルあるいは 楕円で文字を囲む処理を一つのマクロでできると助かります。 Excel97でもこのマクロを使います。 難しい質問で申し訳ありません。宜しくお願い致します。

Excel2003を使っています。 先日パソコンをリカバリしたのですが、リカバリ前にはあったExcelのフォントが現在は大量になくなっており、今までに作ったものの「AR隷流体M」で打った文字がゴシック体に変わっていました。 リカバリ前にも、自分でフォントをインストールした覚えがないので、OfficeかXPのディスクの中か、Windowsの更新で知らぬうちに入ったものだと思うのですが、どなかたかご存知でしたらお教えください。お願いいたします。

VBAのフォーム上で、複数選択ができるListBox1を作っています。 ListBox1を選択する度に、ListBox2へListBox1の選択内容で 絞り込んだListBox2のリストを作るという処理をしたいのですが、 ListBox1_ClickイベントでListBox1のリストクリック時に 何も反応がありません。 .MultiSelect = fmMultiSelectSingle で指定した複数リストボックスはClickイベントが拾えないのでしょうか？ ListBox1リスト内のデータ選択・解除の度にイベントが 発生するようにしたいです。 宜しくお願いします。

VBA素人です。教えてください。 添付シートのようなデータがあるとします。 ユーザーフォームにテキストボックスを作成し、 (1)シート内の型式を型式BOXに手入力で入れる (2)良品数を手入力で入れる (3)日付を手入力で入れる（初期設定はDateをかえす） (1)～(3)を入力し、入力コマンドボタンで型式と日付がFINDするセルに 良品数を入れるコードを下記作成しました。 シート内に対象の型式、日付があれば、うまく作動するのですが、 型式、日付両方が無い場合、もしくはどちらか片方が無い場合は、 うまく作動しません。 おそらく型式FIND～IF、日付FIND～IFの使い方が悪いと思います。 型式がシート内に無ければ、型式エラーとしマクロを抜ける。 型式があり、日付が無ければ、日付エラーでマクロを抜けるコードを教えてください。 なお、型式を手入力で入れていますが、シート内の（"B:B"）セルを選択すると自動で型式テキストボックスに入れる方法もご教示下さい。 Private Sub UserForm_Initialize() 型式BOX = ""'テキストボックス 良品BOX = ""'テキストボックス 日付BOX = Date'テキストボックス 型式BOX.SetFocus End Sub Private Sub 入力_Click() Application.ScreenUpdating = False Application.EnableEvents = False If Len(型式BOX.Value) = 0 Then MsgBox "型式が未選定です" Cancel = True ElseIf Len(良品BOX.Value) = 0 Then MsgBox "良品が未入力です" Cancel = True ElseIf Len(日付BOX.Value) = 0 Then MsgBox "日付が未入力です" Cancel = True Else Dim a As Variant a = 型式BOX.Value Dim b As Date b = 日付BOX.Value On Error Resume Next Columns("B:B").Select ActiveSheet.Cells.Find(a, , , xlWhole, xlByRows, xlNext, False).Select X = ActiveCell.Row If Err = 91 Then MsgBox (prompt) & a & "の型式はありません", _ (vbOKOnly + vbExclamation), ("型式検索結果") Err.Clear End If On Error Resume Next Rows("1:1").Select ActiveSheet.Cells.Find(b, , , xlWhole, xlByColumns, xlNext, False).Select Y = ActiveCell.Column If Err = 91 Then MsgBox (prompt) & b & "の日付はありません", _ (vbOKOnly + vbExclamation), ("日付検索結果") Err.Clear 　 End If Cells(X, Y) = 良品BOX.Value End If End Sub

1日の行動を横棒のグラフで表現したいのですが教えてください。 0時から始まり24時で1日分のグラフを完成する感じです。 たとえば0:00～7:00が睡眠、7:00～8:30が生活、 8:30～12:00が勉強、12:00～14:00が生活、 14:00～20:00が勉強、20:00～22:OOが生活、22:00～24:00が睡眠。 これを横棒1本で表現し色分けしたいのです。 睡眠が左端と右端に分かれます。同じ色にできたら嬉しいです。 勉強は勉強で違う色、という感じです。 翌日分は次の横棒グラフとして下に並べて行きたいのです。 テンプレートがあると嬉しいのですが。。。 ネットで色々調べてみたのですがたどり着かず、こちらに お願いしてみることにしました。 どうぞよろしくお願いします。 追伸。 横棒で複数日を一度に見られる形式でしたらEXCELにこだわりません。 フリーツールでもあれば、と思ってます。