検索機能の構築 - nrp

2009/11/20 (Fri) 15:42:48

初めまして。ご多忙のところ大変恐縮ながら質問させていただきたいことがあります。
現在、顧客管理表を作成しているのですが、ユーザーフォームを利用して検索機能を作成しようと思っています。

現在sheet1に顧客管理表を作成してB列が顧客番号列、B5を起点としてO列まで名前や住所などの情報を入力したものとなっています。

さて、本題なのですが・・
ユーザーフォームにテキストボックスと”検索”ボタンを設置してテキストボックスにキーワードを入力して検索ボタンを押すと検索値に該当する行（顧客）のみを抽出するマクロを作成したいのですがどのようにしたら良いでしょうか？

ちなみにこの検索のユーザーフォームを呼び出すマクロまでは出来ています。

お暇な時で構いませんので教えていただけたらと思います。長文失礼しました。

コピー貼り付けの連続処理 - ウ・コ

2009/11/20 (Fri) 09:09:15

はじめまして、過去のFAQ 「月別フォルダのブックを順に開いて一覧表を作成するには？」
http://www.asahi-net.or.jp/~zn3y-ngi/YNxv9292.html
を見たのですが、私がしたい事と少し違うようなので教えて頂ければ有りがたいです。
私がしたい事
・ファイル名が「○○基本計画表」とか「▲▲基本計画表」と複数あり随時増えていく
・別のフォルダーのシートにコピーしたい
理解できなかった点
過去のFAQの回答では、1月から12月のフォルダーを　For 月 = 1 to 12 　としていましたが私の場合は「○○基本計画表」とか「▲▲基本計画表」と基本計画表以外部分の名前が色々で。
又、コピーして張り付ける際の行を　月+1　と表現していますが、私の場合はどのようにしたらよいのでしょうか?
または、全然違うのでしょうか?

リンクの更新が先に・・・ - nr

2009/11/13 (Fri) 21:30:06

初めまして
マクロを始めたばかりの者です。

エクセル２００３で『マクロを有効にする』のセキュリティー警告メッセージの前に『このブックには、他のデータソースへのリンクが含まれています。』が表示されてしまい、マクロを有効に出来ません。
解決方法があれば教えて下さい。

宜しくお願いします。

データの貼り付け - もんた

2009/11/09 (Mon) 19:21:11

リストから順番にデータを選択し、その計算結果が出てくるセルを別シートの表に貼り付けを行いたいのですが、どのようにすればよいのでしょうか？
現在は、以下のようなマクロをリストの数だけ作成して使用しているのですが…
ご教授お願いいたします。

Sub Macro2()
Sheets("シート1").Select
Range("B5").Select　　　'ここをB5〜B200のように変化させています
Selection.Copy
Range("M2").Select　　　　'ここのセルを計算式に対応させています
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Z39:BF39").Select　　　'計算結果が出てくるセルの範囲です
Application.CutCopyMode = False
Selection.Copy
Sheets("シート2").Select
Range("Y21").Select　　　　　'ここの範囲をY21からY216のように変化させています
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

キーワードで抽出した結果をリストボックスへ表示したい - MN

2009/10/07 (Wed) 20:57:55

500連発第２弾の３９６を利用し、必要なデータ（３列　コードと会社名と部署名）をリストボックス上に表示し、１件のみ・選択した複数データ・選択した連続データの抽出が出来、ＶＢＡが完成しました。ところが、使用者側から、リストボックスの内容をキーワードで検索し、抽出できないか？
例　「東京」キーワードを入力して、会社名と部署名に「東京」というキーワードがあったら、リストボックス表示を再表示して、選択し抽出する。
先生のＨＰ上でもこのような例がなく、シート上にあるキーワードと一致しする検索照会は出来るのを確認できましたが、リストボックスに表示した内容をキーワードで検索できないものでしょうか？

メモリー不足となってしまいます - まな

2009/10/06 (Tue) 15:09:43

お世話になります
ちまちまとマクロを勉強しながらやっていますがマクロを実行するとメモリー不足となってしまいました　解除方法があったら教えてください。

ファイルはxlsm形式で保存
オプションボタンでチェックした項目をセルに入力しています。

Private Sub OptionButton1_Click()
ActiveCell.FormulaR1C1 = "ｍ"
End Sub

Private Sub OptionButton2_Click()
ActiveCell.FormulaR1C1 = "?"
End Sub

Private Sub OptionButton3_Click()
ActiveCell.FormulaR1C1 = "ｍ3"
End Sub

Private Sub OptionButton4_Click()
ActiveCell.FormulaR1C1 = "枚"
End Sub

Private Sub OptionButton5_Click()
ActiveCell.FormulaR1C1 = "回"
End Sub

Private Sub OptionButton6_Click()
ActiveCell.FormulaR1C1 = "箇所"
End Sub

Private Sub OptionButton7_Click()
ActiveCell.FormulaR1C1 = "本"
End Sub

Private Sub OptionButton8_Click()
ActiveCell.FormulaR1C1 = "袋"
End Sub

Private Sub OptionButton9_Click()
ActiveCell.FormulaR1C1 = "ｔ"
End Sub

Private Sub OptionButton10_Click()
ActiveCell.FormulaR1C1 = "?"
End Sub

Private Sub OptionButton11_Click()
ActiveCell.FormulaR1C1 = "個"
End Sub

Private Sub OptionButton12_Click()
ActiveCell.FormulaR1C1 = "台"
End Sub

Private Sub OptionButton13_Click()
ActiveCell.FormulaR1C1 = "式"
End Sub

Private Sub OptionButton14_Click()
ActiveCell.FormulaR1C1 = "〃"
End Sub

実行するとセルに値は入るのですがメモリー不足ですとなってしまいます。
解決方法をお願いします。

次のworkdayの日にちに置き換えるvba - ゆき

2009/09/04 (Fri) 10:55:30

ある日付がworkdayかどうか見極め、土日祝日であれば、次のworkdayの日にちに置き換えるvbaを知りたいです。
Excel2000を使っています。よろしくおねがいします。

株価自動記録 - ｌｏｓｗｅｌ２

2009/09/27 (Sun) 00:26:02

こんにちはＶＢＡ初心者ですが、株価を一分毎に
ＷＥＢクエリーで取得しシートに貼り付け、さらに一時間毎に四本値をエクセルで自動作成するマクロを組みたいのですが、一分毎の貼り付けは問題なく動きますが、60回ｶｳﾝﾄ後、一時間毎の処理をするGoSUBへどうしてもうまく飛んでいってくれません。
どこが悪いのでしょうか、どなたかご教授願えないでしょうか。よろしくお願いします。


Sub 自動記録1()
Dim counter

Application.OnTime Now + TimeValue("00:01:00"), "自動記録1" '一分毎に自動記録1を実行


If counter >= 60 Then GoSub time1 Else: counter = counter + 1

Worksheets("一分値").Activate '一分値をアクティブにする ※１
Range("b3:d61").Copy 'コピーする ※２
Range("b2").Select '貼り付け先のセル範囲を選択する ※３
ActiveSheet.Paste '現在の選択範囲に貼り付ける


Range("b64:c64").Copy 'コピーする ※２
Range("b61").Select '貼り付け先のセル範囲を選択する ※３
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone



Exit Sub

time1:
　　　　　　　　　　　　　　　　'一時間毎に時間値をコピーする

Worksheets("一時間値").Activate '一時間値をアクティブにする ※１
Range("b3:ｆ61").Copy 'コピーする ※２
Range("b2").Select '貼り付け先のセル範囲を選択する ※３
ActiveSheet.Paste '現在の選択範囲に貼り付ける


Range("b65:f65").Copy 'コピーする ※２
Range("b61").Select '貼り付け先のセル範囲を選択する ※３
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

counter = 0

Worksheets("一分値").Activate '一分値をアクティブにする

Return

End Sub

VBA自動実行 - ミルトン

2009/08/16 (Sun) 17:59:42

はじめまして。
ホームページに似たような質問があったのですが、応用が出来ずに困っています。
このページの質問です。（http://www.asahi-net.or.jp/~ZN3Y-NGI/YNxv9c7.html)

このページの質問は特定のセルに特定の値が入力されたときだと思うのですが、
特定のセルに何らかの値が入力された時、プロシージャを実行するにはどうしたらよいのでしょうか。

さらに私がやりたいのは、
セルA１に入力ーーーー＞プロシージャAを実行
セルB２に入力ーーーー＞プロシージャBを実行
　　　　　　　・
　　　　　　　・
　　　　　　　・
のようにしたいのです。

お手数ですが回答よろしくお願いします。

テキスト書き出し - 鶏肋

2009/08/11 (Tue) 17:21:05

こんにちは。
現在、Excelの各シートのテキストボックス内の文字を書き出し、一覧表にするマクロを作っているのですが、行き詰ってしまったのでご教示お願いいたします。

マクロでは、一番最後にシートを一枚プラスし、そこに各シートのテキストボックス内の文字を書き出しています。（初心者なので構文に無駄が多いかもしれませんが）。

問題なのですが、たとえば以下のようなパターンがあるとします。
?シート1に「報告書」と書かれたテキストボックスが１つある。
?シート1に「報告書」と書かれたテキストボックスが１つと、オートシェイプの矢印が１つある。
?シート1に「報告書」と書かれたテキストボックスが２つと、オートシェイプの矢印が１つある。

?の場合は、一覧にちゃんと「報告書」と書き出されるので問題ありません。
問題は??で、?の場合、一覧には「報告書」と2度書き出されてしまいます。
これを1度にしたいのです。
書き出した後、重複する文字を削除する方法も考えましたが、それでは?に対応できません。
（現時点のマクロでは、?の場合、「報告書」という文字が3回書き出されます。これを2回にしたいです）。

基本的なことかもしれませんが、よくわからないので、よろしくお願いいたします。

私が書いたマクロは以下のとおりです。

Sub TextFrameExport()

Application.ScreenUpdating = False

Worksheets.Add after:=Worksheets(Sheets.Count)

Dim myShname As String
Dim i As Integer
Dim myCount As Integer

myCount = Worksheets.Count - 1


Select Case myCount

Case Is = 1

Worksheets(Sheets.Count).Select
Range("A1").Value = Worksheets(1).Name

Dim myRng As Range
Dim myCell As Range
Dim wsName As String
Dim myShape As Shape
Dim myTxt As String
Dim j As Long

Worksheets(Sheets.Count).Range("A1").Select
Set myRng = Worksheets(Sheets.Count).Range("A1")
For Each myCell In myRng
wsName = myCell.Value
For Each myShape In Worksheets(wsName).Shapes
On Error Resume Next
myTxt = myShape.TextFrame.Characters.Text
On Error GoTo 0

If myTxt <> Empty Then
j = j + 1
myCell.Offset(0, j).Value = myTxt
End If
Next
myTxt = ""
j = 0
Next


Case Else

For i = 1 To myCount
Worksheets(Sheets.Count).Select
Range("A1").Offset(i - 1, 0).Value = Worksheets(i).Name
i = i
Next


Worksheets(Sheets.Count).Range("A1").Select
Set myRng = Worksheets(Sheets.Count).Range(Selection, Selection.End(xlDown))
For Each myCell In myRng
wsName = myCell.Value
For Each myShape In Worksheets(wsName).Shapes
On Error Resume Next
myTxt = myShape.TextFrame.Characters.Text
On Error GoTo 0

If myTxt <> Empty Then
j = j + 1
myCell.Offset(0, j).Value = myTxt
End If
Next
myTxt = ""
j = 0
Next

End Select

Application.ScreenUpdating = True

End Sub